orchestrate (empty) → 0.2.0.0
raw patch · 14 files changed
+1652/−0 lines, 14 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, bytestring, case-insensitive, data-default, either, errors, hspec, http-client, http-types, lens, mtl, orchestrate, smallcheck, text, transformers, unordered-containers, wreq
Files
- LICENSE +202/−0
- Setup.hs +2/−0
- orchestrate.cabal +78/−0
- specs/Specs.hs +1/−0
- src/Database/Orchestrate.hs +25/−0
- src/Database/Orchestrate/Collection.hs +30/−0
- src/Database/Orchestrate/Events.hs +174/−0
- src/Database/Orchestrate/Graph.hs +73/−0
- src/Database/Orchestrate/KeyValue.hs +152/−0
- src/Database/Orchestrate/Network.hs +36/−0
- src/Database/Orchestrate/Ref.hs +57/−0
- src/Database/Orchestrate/Search.hs +38/−0
- src/Database/Orchestrate/Types.hs +446/−0
- src/Database/Orchestrate/Utils.hs +338/−0
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ orchestrate.cabal view
@@ -0,0 +1,78 @@+-- Initial orchestrate.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: orchestrate+version: 0.2.0.0+synopsis: An API client for http://orchestrate.io/.+-- description: +license: Apache-2.0+license-file: LICENSE+author: Eric Rochester+maintainer: erochest@gmail.com+-- copyright: +category: Database+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++flag network-specs+ description: Include specs that hit the live network site. Needs to+ be run with tests enabled to do anything.+ default: False++library+ hs-source-dirs: src+ exposed-modules: Database.Orchestrate+ , Database.Orchestrate.Collection+ , Database.Orchestrate.Events+ , Database.Orchestrate.Graph+ , Database.Orchestrate.KeyValue+ , Database.Orchestrate.Network+ , Database.Orchestrate.Ref+ , Database.Orchestrate.Search+ , Database.Orchestrate.Types+ , Database.Orchestrate.Utils+ -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && <4.8+ , text+ , wreq+ , http-client+ , http-types+ , aeson+ , unordered-containers+ , errors+ , either+ , mtl+ , lens+ , data-default+ , bytestring+ , case-insensitive+ , transformers+ -- hs-source-dirs: + default-language: Haskell2010++test-suite orchestrate-specs+ type: exitcode-stdio-1.0+ ghc-options: -threaded -rtsopts+ hs-source-dirs: specs+ main-is: Specs.hs+ build-depends: base == 4.7.*+ , orchestrate+ , QuickCheck+ , smallcheck+ , hspec+ , lens+ , text+ , aeson+ , bytestring+ , wreq+ , errors+ default-language: Haskell2010+ if flag(network-specs)+ cpp-options: -DNETWORK_SPECS++source-repository this+ type: git+ location: git://github.com/erochest/orchestrate.git+ tag: 0.2.0.0
+ specs/Specs.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ src/Database/Orchestrate.hs view
@@ -0,0 +1,25 @@+++module Database.Orchestrate+ ( module Database.Orchestrate.Collection+ , module Database.Orchestrate.Events+ , module Database.Orchestrate.Graph+ , module Database.Orchestrate.KeyValue+ , module Database.Orchestrate.Network+ , module Database.Orchestrate.Ref+ , module Database.Orchestrate.Search+ , module Database.Orchestrate.Types+ , module Database.Orchestrate.Utils+ ) where+++import qualified Database.Orchestrate.Collection+import qualified Database.Orchestrate.Events+import qualified Database.Orchestrate.Graph+import qualified Database.Orchestrate.KeyValue+import qualified Database.Orchestrate.Network+import qualified Database.Orchestrate.Ref+import qualified Database.Orchestrate.Search+import qualified Database.Orchestrate.Types+import qualified Database.Orchestrate.Utils+
+ src/Database/Orchestrate/Collection.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}+++{-|+This implements the <http://orchestrate.io/api/collections API calls> to+manage collections on Orchestrate.+-}++module Database.Orchestrate.Collection+ ( deleteCollection+ ) where+++import Control.Monad+import qualified Data.Text as T+import Network.Wreq++import Database.Orchestrate.Types+import Database.Orchestrate.Utils+++-- | This deletes a collection. See+-- <http://orchestrate.io/api/collections#delete the API documentation> for+-- more information.+--+-- > deleteCollection "collection-name"++deleteCollection :: Collection -> OrchestrateIO ()+deleteCollection c =+ void $ apiCheck [] [c] ["force" := ("true" :: T.Text)] deleteWith
+ src/Database/Orchestrate/Events.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{- |+This module implements the <http://orchestrate.io/api/events API calls> for+working with Orchestrate events.+-}+++module Database.Orchestrate.Events+ (+ -- * API Functions+ getEvent+ , createEvent+ , updateEvent+ , deleteEvent+ , listEvents++ -- * Location Conversion Functions+ , locationEventItem+ , eventItemLocation+ ) where+++import Control.Applicative+import Control.Lens+import Control.Monad+import Data.Aeson+import Data.Maybe+import Data.Monoid+import qualified Data.Text as T+import Network.Wreq++import Database.Orchestrate.Types+import Database.Orchestrate.Utils+++urlPath :: OrchestrateData a => a -> EventType -> Timestamp -> Int -> [T.Text]+urlPath a et ts o = [tableName a, dataKey a, "events", et, tshow ts, tshow o]++-- | This retrieves a single event. See <http://orchestrate.io/api/events the API documentation>+-- for more information.+--+-- For example, this retrieves a transaction event.+--+-- > getEvent data "transaction" 784111777000 79+getEvent :: (OrchestrateData a, FromJSON b)+ => a -- ^ The data that the event is associated with.+ -> EventType -- ^ The kind of event.+ -> Timestamp -- ^ The event's timestamp.+ -> Int -- ^ The event's ordinal number.+ -> OrchestrateIO (Maybe (EventItem b a)) -- ^ 'Just' the event or 'Nothing'.+getEvent a etype ts o =+ join . fmap (decode . (^.responseBody)) <$> api404 [] up [] getWith+ where up = urlPath a etype ts o++-- | This creates an event and returns its 'Location'. See+-- <http://orchestrate.io/api/events API document> for more information.+--+-- For example, this creates a transaction, using the current time for the+-- timestamp.+--+-- > createEvent data "transaction" transactionData Nothing+createEvent :: (OrchestrateData a, ToJSON b)+ => a -- ^ The data that the event is associated with.+ -> EventType -- ^ The kind of event.+ -> b -- ^ The event data.+ -> Maybe Timestamp -- ^ The event's timestamp. If not given, the current time is used.+ -> OrchestrateIO Location -- ^ Returns the event's location.+createEvent a eType e mts =+ getLocation <$> api [] url [] (rot postWith (toJSON e))+ where url = [tableName a, dataKey a, "events", eType]+ ++ maybeToList (fmap tshow mts)++-- | This updates the data for an event. The storage is keyed by type,+-- timestamp, and ordinal, so the event data can change. See the+-- <http://orchestrate.io/api/events API documentation> for more+-- information.+--+-- For example:+--+-- > updateEvent data "transaction" updatedTransactionData+-- > <$> loc ^? locationTimestamp+-- > <*> loc ^? locationOrdinal+updateEvent :: (OrchestrateData a, ToJSON b)+ => a -- ^ The data that the event is associated with.+ -> EventType -- ^ The kind of event.+ -> b -- ^ The updated event data.+ -> Timestamp -- ^ The timestamp for the event.+ -> Int -- ^ The ordinal for the event.+ -> IfMatch' -- ^ If given, will only succeed if the ref matches+ -- the event's currently stored ref.+ -> OrchestrateIO Location -- ^ Returns the 'Location' for the new event data.+updateEvent a eType e ts o m =+ getLocation <$> api (ifMatch' m) up [] (rot putWith (toJSON e))+ where up = urlPath a eType ts o++-- | This deletes an event. See the <http://orchestrate.io/api/events API documentation>+-- for more information.+--+-- For example:+--+-- > deleteEvent data "transaction"+-- > <$> loc ^? locationTimestamp+-- > <*> loc ^? locationOrdinal+deleteEvent :: OrchestrateData a+ => a -- ^ The data that the event is associated with.+ -> EventType -- ^ The kind of event.+ -> Timestamp -- ^ The timestamp for the event.+ -> Int -- ^ The ordinal for the event.+ -> IfMatch' -- ^ If given, will only succeed if the ref matches+ -- the event's currently stored ref.+ -> OrchestrateIO ()+deleteEvent a eType ts o m =+ void $ apiCheck (ifMatch' m) url ["purge" := ("true" :: T.Text)] deleteWith+ where url = urlPath a eType ts o++-- | This lists all the events within a given range for a data. See the+-- <http://orchestrate.io/api/events API documentation> for more+-- information.+--+-- For example:+--+-- > listEvents data "transaction" (Just 25) (Open, Open)+listEvents :: (OrchestrateData a, FromJSON b)+ => a -- ^ The data the events are to associated with.+ -> EventType -- ^ The type of events to retrieve.+ -> Maybe Int -- ^ The maximum number of event data to return.+ -- The default is 10, and the maximum is 100.+ -> Range (Timestamp, Maybe Int) -- ^ The range of events to retrieve. Each range+ -- is the timestamp and maybe the ordinal.+ -> OrchestrateIO (EventList b a)+listEvents a eType limit (start, end) = apiCheckDecode [] up ps getWith+ where up = [tableName a, dataKey a, "events", eType]+ ps = catMaybes [ ("limit" :=) <$> limit+ , rangeStart "Event" $ fmap eventRange start+ , rangeEnd "Event" $ fmap eventRange end+ ]+ eventRange (ts, mint) = tshow ts <> maybe mempty (("/" <>) . tshow) mint++-- | This takes a 'Location' and an event datum and returns the 'EventItem'+-- representing it.+locationEventItem :: Location -> a -> Maybe (EventItem a b)+locationEventItem loc a = EventItem <$> resultItem a <*> timestamp <*> ordinal+ where timestamp = loc ^? locationTimestamp+ ordinal = loc ^? locationOrdinal+ resultItem x = (`ResultItem` x) <$> ePath+ ePath = EventPath+ <$> path+ <*> loc ^? locationType+ <*> timestamp+ <*> ordinal+ path = Path+ <$> loc ^? locationCollection+ <*> loc ^? locationKey+ <*> loc ^? locationRef++-- | This takes an 'EventItem' and returns the datum and 'Location'+-- associated with that item.+eventItemLocation :: Monad m => EventItem a b -> OrchestrateT m (a, Location)+eventItemLocation ei = do+ v <- view sessionVersion+ let epath = ei ^. eventItem . itemPath+ path = epath ^. eventPath+ loc = T.intercalate "/" [ ""+ , "v" <> tshow v+ , path ^. itemCollection+ , path ^. itemKey+ , "events"+ , epath ^. eventPathType+ , tshow $ epath ^. eventPathTime+ , tshow $ epath ^. eventPathOrd+ ]+ return (ei ^. eventItem . itemValue, loc)
+ src/Database/Orchestrate/Graph.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+This module implements the <http://orchestrate.io/api/graph Graph API>.+-}++module Database.Orchestrate.Graph+ ( getRel+ , createRel+ , deleteRel+ ) where+++import Control.Monad+import Data.Aeson+import qualified Data.Text as T+import Network.Wreq++import Database.Orchestrate.Types+import Database.Orchestrate.Utils+++-- | This retrieves a list of target nodes from edges originating from @a@.+-- For more information see <http://orchestrate.io/api/graph the API documentation>.+--+-- If the third parameter is not empty, it represents additional edges that+-- will be traversed to get to the target.+--+-- For example:+--+-- > getRel data "friend" ["last_name"]+getRel :: (OrchestrateData a, FromJSON b)+ => a -- ^ The originating node.+ -> RelKind -- ^ The first edge to traverse.+ -> [RelKind] -- ^ Any additional edges to traverse.+ -> OrchestrateIO (RelList a b) -- ^ A list of nodes originating from @a@.+getRel from rel rels = apiCheckDecode [] url [] getWith+ where url = tableName from : dataKey from : "relations" : rel : rels++-- | Creates a relationship (an edge) between two nodes. The edge has+-- a 'RelKind' type. See the <http://orchestrate.io/api/graph API documentation>+-- for more information.+--+-- For example:+--+-- > createRel start "parent" child+createRel :: (OrchestrateData a, OrchestrateData b)+ => a -- ^ The originating node.+ -> RelKind -- ^ The label for the edge.+ -> b -- ^ The target, destination node.+ -> OrchestrateIO ()+createRel from rel to = void $ apiCheck [] url [] $ \o s -> putWith o s Null+ where url = [ tableName from , dataKey from+ , "relation", rel+ , tableName to, dataKey to+ ]++-- | This removes a relationship (an edge) between two nodes.+--+-- For example:+--+-- > deleteRel start "parent" child+deleteRel :: (OrchestrateData a, OrchestrateData b)+ => a -- ^ The originating node.+ -> RelKind -- ^ The label for the edge.+ -> b -- ^ The target, destination node.+ -> OrchestrateIO ()+deleteRel from rel to =+ void $ apiCheck [] url ["purge" := ("true" :: T.Text)] deleteWith+ where url = [ tableName from, dataKey from+ , "relation", rel+ , tableName to, dataKey to+ ]
+ src/Database/Orchestrate/KeyValue.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+++{-|+This implements the <http://orchestrate.io/api/keyvalue Key/Value> API.++Generally, the data stored knows about its own key using via the+'OrchestrateData' class instance defined for it.+-}+++module Database.Orchestrate.KeyValue+ (+ -- * Accessing Data+ lookup+ , listVals+ -- * Adding and Updating Data+ , putV+ , putKV+ , postV+ -- * Deleting Data+ , deleteV+ , deleteKV+ , purgeV+ , purgeKV+ ) where+++import Control.Applicative+import Control.Arrow+import Control.Error+import Control.Lens+import Control.Monad (join, void)+import Data.Aeson+import qualified Data.Text as T+import Network.Wreq+import Prelude hiding (lookup)++import Database.Orchestrate.Types+import Database.Orchestrate.Utils+++-- | This retrieves a value from a collection.+--+-- > lookup "contacts" "mom"+lookup :: FromJSON v => Collection -> Key -> OrchestrateIO (Maybe v)+lookup c k =+ join . fmap (decode . (^.responseBody)) <$> api404 [] [c, k] [] getWith++-- | This inserts data into the database or updates existing data using+-- a key generated by the 'OrchestrateData' instance.+--+-- > putV data NoMatch+putV :: OrchestrateData v+ => v -- ^ The data to store in the database.+ -> IfMatch -- ^ If specified, this operation only succeeds+ -- if the ref specified matches the+ -- currently stored ref for this data.+ -> OrchestrateIO Location -- ^ Returns the location of the data.+putV v = putKV (dataKey v) v++-- | This inserts data into the database or updates data in the database.+-- This overrides the key provided by the data type's 'OrchestrateData'+-- instance. However, it still requires an implementation of that data type+-- for the collection name.+--+-- > putKV "key" data NoMatch+putKV :: OrchestrateData v+ => Key -- ^ The key to store the data under.+ -> v -- ^ The data to store.+ -> IfMatch -- ^ If specified, this operation only succeeds+ -- if the ref specified matches the currently+ -- stored ref for this data.+ -> OrchestrateIO Location -- ^ Returns the location of the data.+putKV k v m =+ getLocation <$> api (ifMatch m) [tableName v, k] [] (rot putWith v')+ where v' = toJSON v++-- | This inserts data in the database, generating a new database key for+-- it.+--+-- > postV data+postV :: OrchestrateData v+ => v -- ^ The data to store.+ -> OrchestrateIO (Location, Maybe Key) -- ^ The 'Location' and key for the data.+postV v = (id &&& firstOf locationKey) . getLocation+ <$> api [] [tableName v] [] (rot postWith (toJSON v))++-- | This removes data from the database.+--+-- > deleteV data Nothing+deleteV :: OrchestrateData v+ => v -- ^ The data to remove.+ -> IfMatch' -- ^ If given, this operation only succeeds+ -- if the ref specified matches the currently+ -- stored ref for this data.+ -> OrchestrateIO ()+deleteV v = deleteKV (dataKey v) v++-- | This removes data from the database.+--+-- > deleteKV "key" data Nothing+deleteKV :: OrchestrateData v+ => Key -- ^ The key the data is stored under.+ -> v -- ^ The data to remove.+ -> IfMatch' -- ^ If given, this operation only succeeds+ -- if the ref specified matches the+ -- currently stored ref for this data.+ -> OrchestrateIO ()+deleteKV k v m = void $ apiCheck (ifMatch' m) [tableName v, k] [] deleteWith++-- | This purges data from the database. Purging not only removes the data,+-- but also all history and secondary items for it.+--+-- > purgeV data Nothing+purgeV :: OrchestrateData v+ => v -- ^ The data to remove.+ -> IfMatch' -- ^ If given, this operation only succeeds+ -- if the ref specified matches the+ -- currently stored ref for this data.+ -> OrchestrateIO ()+purgeV v = purgeKV (dataKey v) v++-- | This purges data from the database. Purging not only removes the data,+-- but also all history and secondary items for it.+--+-- > purgeKV "key" data Nothing+purgeKV :: OrchestrateData v+ => Key -- ^ The key the data is stored under.+ -> v -- ^ The data to remove.+ -> IfMatch' -- ^ If given, this operation only succeeds+ -- if the ref specified matches the+ -- currently stored ref for this data.+ -> OrchestrateIO ()+purgeKV k v m =+ void $ apiCheck (ifMatch' m) [tableName v, k]+ ["purge" := ("true" :: T.Text)] deleteWith++-- | This lists all the data in the collection within the range given.+--+-- > listVals "coll-name" Nothing (Open, Open)+listVals :: FromJSON v+ => Collection -- ^ The collection to list data from.+ -> Maybe Int -- ^ The maximum number of items to retrieve.+ -> Range Key -- ^ The range of keys to query.+ -> OrchestrateIO (KVList v) -- ^ Returns a collection of data.+listVals c limit (start, end) = apiCheckDecode [] [c] ps getWith+ where ps = catMaybes [ ("limit" :=) <$> limit+ , rangeStart "Key" start+ , rangeEnd "Key" end+ ]
+ src/Database/Orchestrate/Network.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}+++{- |+This module implements some network-oriented utility functions.+-}++module Database.Orchestrate.Network+ ( checkResponse+ , checkStatusCode+ ) where+++import qualified Control.Exception as Ex+import Control.Lens+import Network.Wreq++import Database.Orchestrate.Types+++-- | This takes a response and checks that the status code passes.+--+-- If the HTTP status code is not OK, this returns an error in the+-- 'OrchestrateT' monad.+checkResponse :: Monad m => Response a -> OrchestrateT m ()+checkResponse = checkStatusCode . view (responseStatus . statusCode)++-- | This checks the status code. Currently 200 and 204 are OK. Everything+-- else is bad. Bad codes throw an exception in 'OrchestrateT'.+checkStatusCode :: Monad m => Int -> OrchestrateT m ()+checkStatusCode 200 = return ()+checkStatusCode 204 = return ()+checkStatusCode rc = throwError+ . Ex.SomeException+ . Ex.ErrorCall+ $ "Invalid response: " ++ show rc
+ src/Database/Orchestrate/Ref.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{- |+This module implements the <http://orchestrate.io/api/keyvalue Orchestrate Refs API>.++Refs represent the immutable values that have been associated with a key.+-}+++module Database.Orchestrate.Ref+ ( getRef+ , listRefs+ ) where+++import Control.Applicative+import Control.Error+import Control.Lens+import Control.Monad+import Data.Aeson+import Data.Aeson.Types (Parser)+import qualified Data.HashMap.Strict as M+import qualified Data.Text as T+import Network.Wreq++import Database.Orchestrate.Types+import Database.Orchestrate.Utils+++-- | This retrieves a ref associated with some data.+--+-- > getRef "coll-name" "key" "43214321"+getRef :: FromJSON r => Collection -> Key -> Ref -> OrchestrateIO (Maybe r)+getRef c k r =+ join . fmap (decode . (^.responseBody)) <$> api404 [] [c, k, "refs", r] [] getWith++-- | This lists all the values that have been associated with a key in the+-- database. Values are returned last to first.+--+-- > listRefs "coll-name" "key" Nothing Nothing False+listRefs :: FromJSON v+ => Collection -- ^ This is the collection for the data.+ -> Key -- ^ This is the key for the data.+ -> Maybe Int -- ^ The maximum number of items to return.+ -> Maybe Int -- ^ The offset into the total sequence of values.+ -> Bool -- ^ Should the values be returned also, or just the 'Path' data?+ -> OrchestrateIO (ResultList (TombstoneItem v))+ -- ^ Returns the list of results.+listRefs c k limit offset values =+ apiCheckDecode [] [c, k, "refs"] parms getWith+ where ifm True = Just+ ifm False = const Nothing+ parms = catMaybes [ ifm values $ "values" := ("true" :: T.Text)+ , ("limit" :=) . show <$> limit+ , ("offset" :=) . show <$> offset+ ]
+ src/Database/Orchestrate/Search.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{- |+This module implements the <http://orchestrate.io/api/search Orchestrate Search API>.+-}++-- TODO: Create class for query values. Instantiate on Text and [(Text,+-- Text)], maybe also on ADTs for representing the query structures.++module Database.Orchestrate.Search+ ( query+ ) where+++import Control.Applicative+import Control.Error+import Data.Aeson+import Network.Wreq++import Database.Orchestrate.Types+import Database.Orchestrate.Utils+++-- | This performs the query and returns the results.+--+-- > query "coll-name" "query" (Just 25) Nothing+query :: FromJSON v+ => Collection -- ^ The collection to query.+ -> QueryText -- ^ The query.+ -> Maybe Int -- ^ The maximum number of items to return.+ -> Maybe Int -- ^ The offset into the search results.+ -> OrchestrateIO (SearchList v) -- ^ Returns the results of the query with their scores.+query c q limit offset = apiCheckDecode [] [c] parms getWith+ where parms = catMaybes [Just $ "query" := q+ , ("limit" :=) <$> limit+ , ("offset" :=) <$> offset+ ]
+ src/Database/Orchestrate/Types.hs view
@@ -0,0 +1,446 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wall #-}+++-- TODO: Clean this up some. Eeek.++module Database.Orchestrate.Types+ (+ -- * General Types+ -- ** Aliases+ APIKey+ , Collection+ , Key+ , Ref+ , Timestamp+ , Location+ , RestCall+ -- ** Result Limits+ , Limit+ , Offset+ -- ** Conditional API Calls+ , IfMatch'+ , IfMatch(..)+ -- ** Ranges+ , Range+ , RangeEnd(..)++ -- * Key/Value Types+ , KVList++ -- * Ref Types+ , TombstoneItem(..)++ -- ** Type Lenses and Prisms+ , _TombstoneItem+ , _LiveItem+ , livePath+ , liveTime+ , liveValue+ , tombstonePath+ , tombstoneTime++ -- * Event Types+ -- ** Type Aliases+ , EventList+ , EventType++ -- ** Event Location+ , EventPath(..)+ , eventPath+ , eventPathType+ , eventPathTime+ , eventPathOrd++ -- ** Event Data+ , EventItem(..)+ , eventItem+ , eventTime+ , eventOrd++ -- * Graph Types+ , RelKind+ , RelList++ -- * Search Types+ , QueryText++ -- ** List of Search Results+ , SearchList(..)+ , searchResults+ , searchTotal++ -- ** Single Search Result+ , SearchItem(..)+ , searchItem+ , searchScore++ -- * Session+ , Session(..)+ , sessionURL+ , sessionKey+ , sessionVersion+ , sessionOptions++ -- * Orchestrate Types+ -- ** Data+ , OrchestrateData(..)+ -- ** Monad Types+ , OrchestrateT(..)+ , OrchestrateIO+ , Orchestrate++ -- * Result Types+ -- ** Lists of Results+ , ResultList(..)+ , resultCount+ , resultList+ , resultPrev+ , resultNext+ -- ** Individual Results+ , ResultItem(..)+ , itemPath+ , itemValue+ -- ** Rich Item Locations (Paths)+ , Path(..)+ , itemCollection+ , itemKey+ , itemRef++ -- * Re-exports+ -- ** Accessing Data+ , ask+ , asks+ -- ** Throwing and Handling Errors+ , throwError+ , catchError+ ) where+++import Control.Applicative+import Control.Error+import qualified Control.Exception as Ex+import Control.Lens hiding ((.=))+import Control.Monad+import Control.Monad.Error.Class+import Control.Monad.Reader+import Data.Aeson+import Data.Aeson.Types (Parser)+import Data.Default+import qualified Data.HashMap.Strict as M+import qualified Data.Text as T+import Network.Wreq+++type APIKey = T.Text+type Collection = T.Text+type Key = T.Text+type Ref = T.Text+type Timestamp = Integer+type Location = T.Text+type IfMatch' = Maybe Ref+type Limit = Int+type Offset = Int+type EventType = T.Text+type RelKind = T.Text+type QueryText = T.Text++-- | This represents a function that makes a call to the Orchestrate API+-- server. It takes 'Options', a URL 'String', and returns a 'Response'.+type RestCall a = Options -> String -> IO (Response a)++-- | A richer type than 'IfMatch' for specifying conditional calls.+data IfMatch = IfMatch Ref -- ^ Only perform the action if the ref does exist.+ | IfNoneMatch Ref -- ^ Only perform the action if the ref does not exist.+ | NoMatch -- ^ Always perform the action.+ deriving (Show)++-- | This is a range tuple. Each end can be specified separately.+type Range a = (RangeEnd a, RangeEnd a)++-- | This represents the end of a range.+data RangeEnd a = Inclusive a -- ^ The end should be inclusive. I.e., it should include @a@.+ | Exclusive a -- ^ The end should be exclusive. I.e., it should not include @a@.+ | Open -- ^ There is no bound on this end.+ deriving (Show, Functor)++-- | The data for a session with the Orchestrate database.+data Session = Session+ { _sessionURL :: !T.Text -- ^ The base URL for the Orchestrate API.+ , _sessionKey :: !APIKey -- ^ The API key for accessing the API.+ , _sessionVersion :: !Int -- ^ The version of the API.+ , _sessionOptions :: !Options -- ^ The baseline set of 'Options' for making+ -- wreq calls. This includes the API key.+ } deriving (Show)+$(makeLenses ''Session)++instance Default Session where+ def = Session "https://api.orchestrate.io" "" 0+ $ defaults & header "Content-Type" .~ ["application/json"]+ & header "Accept" .~ ["application/json"]++-- | This is a class for data that can be stored in an Orchestrate+-- <http://orchestrate.io/api/keyvalue Key/Value> store. See+-- "Database.Orchestrate.KeyValue" for where this is used.+class (ToJSON a, FromJSON a) => OrchestrateData a where+ -- | This is the name of the collection to store this data type in.+ tableName :: a -> Collection+ -- | This is the key to store the value in.+ dataKey :: a -> Key++-- | The type for the Orchestrate monad. All interactions with the+-- Orchestrate API are run in this monad. It combines a reader over+-- 'Session' data with error handling using 'EitherT' 'Ex.SomeException'.+newtype OrchestrateT m a+ = OrchestrateT+ { runOrchestrate :: EitherT Ex.SomeException (ReaderT Session m) a }+ deriving (Functor, Applicative, Monad)++instance MonadTrans OrchestrateT where+ lift = OrchestrateT . lift . lift++instance MonadIO m => MonadIO (OrchestrateT m) where+ liftIO = OrchestrateT . liftIO . liftIO++instance Monad m => MonadReader Session (OrchestrateT m) where+ ask = OrchestrateT . lift $ ask+ local f = OrchestrateT . local f . runOrchestrate++-- TODO: Need to define this for other monad classes.++instance Monad m => MonadError Ex.SomeException (OrchestrateT m) where+ throwError = OrchestrateT . EitherT . return . Left+ catchError a handler = join+ . fmap (handler' handler)+ . lift+ . runReaderT (runEitherT $ runOrchestrate a)+ =<< ask++handler' :: Monad m+ => (Ex.SomeException -> OrchestrateT m a)+ -> Either Ex.SomeException a+ -> OrchestrateT m a+handler' _ (Right v) = return v+handler' f (Left e) = f e++-- | 'OrchestrateT' over 'Identity'. Only the most useless monad ever.+type Orchestrate = OrchestrateT Identity++-- | 'OrchestrateT' over 'IO', the way God intended.+type OrchestrateIO = OrchestrateT IO++-- | This represents the unique access information for a value in the+-- store.+data Path = Path+ { _itemCollection :: !Collection -- ^ The collection containing the data.+ , _itemKey :: !Key -- ^ The data's key in the collection.+ , _itemRef :: !Ref -- ^ The reference to the current version+ -- of the value.+ } deriving (Show)+$(makeLenses ''Path)++instance FromJSON Path where+ parseJSON (Object o) = Path+ <$> o .: "collection"+ <*> o .: "key"+ <*> o .: "ref"+ parseJSON _ = mzero++instance ToJSON Path where+ toJSON (Path c k r) = object [ "collection" .= c+ , "key" .= k+ , "ref" .= r+ ]++-- | A parameterized list of results returned by an API call.+--+-- [@i@] the type of the data contained.+data ResultList i = ResultList+ { _resultCount :: !Int+ , _resultList :: ![i]+ , _resultPrev :: !(Maybe Location)+ , _resultNext :: !(Maybe Location)+ } deriving (Show)+$(makeLenses ''ResultList)++instance FromJSON r => FromJSON (ResultList r) where+ parseJSON (Object o) = ResultList+ <$> o .: "count"+ <*> o .: "results"+ <*> o .:? "prev"+ <*> o .:? "next"+ parseJSON _ = mzero++-- | A parameterized single item returned in a collection by an API call.+--+-- [@p@] the type of the path data to this data.+-- [@v@] the type of the value for this data.+data ResultItem p v = ResultItem+ { _itemPath :: !p+ , _itemValue :: !v+ } deriving (Show)+$(makeLenses ''ResultItem)++instance (FromJSON p, FromJSON v) => FromJSON (ResultItem p v) where+ parseJSON (Object o) = ResultItem+ <$> o .: "path"+ <*> o .: "value"+ parseJSON _ = mzero++instance (ToJSON p, ToJSON v) => ToJSON (ResultItem p v) where+ toJSON (ResultItem p v) = object ["path" .= p, "value" .= v]++-- | The data necessary to access an event.+data EventPath = EventPath+ { _eventPath :: !Path -- ^ The base 'Path' to this data.+ , _eventPathType :: !EventType -- ^ The kind of event.+ , _eventPathTime :: !Timestamp -- ^ The event's timestamp.+ , _eventPathOrd :: !Int -- ^ The event's ordinal number.+ } deriving (Show)+$(makeLenses ''EventPath)++instance FromJSON EventPath where+ parseJSON o'@(Object o) = EventPath+ <$> parseJSON o'+ <*> o .: "type"+ <*> o .: "timestamp"+ <*> o .: "ordinal"+ parseJSON _ = mzero++instance ToJSON EventPath where+ toJSON (EventPath p et ts o) =+ Object $ case toJSON p of+ Object m -> m `M.union` epm+ _ -> epm+ where epm = M.fromList [ ("type", toJSON et)+ , ("timestamp", toJSON ts)+ , ("ordinal", toJSON o)+ ]++-- | One item in an 'EventList'.+--+-- This data type uses two parameters:+--+-- [@a@] The type of data being stored for the event.+--+-- [@b@] A phantom type for the type of data associated with the event.+-- This data must also be stored in Orchestrate using the+-- "Database.Orchestrate.KeyValue" API.+data EventItem a b = EventItem+ { _eventItem :: !(ResultItem EventPath a) -- ^ The data itself and the path to it.+ , _eventTime :: !Timestamp -- ^ The event's timestamp.+ , _eventOrd :: !Int -- ^ The event's ordinal number.+ } deriving (Show)+$(makeLenses ''EventItem)++instance FromJSON a => FromJSON (EventItem a b) where+ parseJSON o'@(Object o) = EventItem+ <$> parseJSON o'+ <*> o .: "timestamp"+ <*> o .: "ordinal"+ parseJSON _ = mzero++-- | 'TombstoneItem' data represents the data values in the database.+data TombstoneItem v =+ -- | 'TombstoneItem' data are no longer alive. They are simply markers+ -- for deleted data.+ TombstoneItem { _tombstonePath :: !Path -- ^ The path to the deleted data.+ , _tombstoneTime :: !Timestamp -- ^ The timestamp of this data.+ }+ -- | 'LiveItem' data are still in the database.+ | LiveItem { _livePath :: !Path -- ^ The path to the data.+ , _liveValue :: !(Maybe v) -- ^ If values are requested,+ -- this will contain the data.+ , _liveTime :: !Timestamp -- ^ The timestamp for the data.+ }+ deriving (Show)+$(makeLenses ''TombstoneItem)++-- | A 'Prism'' into data created with the 'TombstoneItem' constructor.+_TombstoneItem :: Prism' (TombstoneItem v) (TombstoneItem v)+_TombstoneItem = prism' id $ \i ->+ case i of+ TombstoneItem{} -> Just i+ LiveItem{} -> Nothing++-- | A 'Prism'' into data created with the 'LiveItem' constructor.+_LiveItem :: Prism' (TombstoneItem v) (TombstoneItem v)+_LiveItem = prism' id $ \i ->+ case i of+ TombstoneItem{} -> Nothing+ LiveItem{} -> Just i++emptyObject :: FromJSON v => Maybe Value -> Parser (Maybe v)+emptyObject (Just o@(Object m)) | M.null m = return Nothing+ | otherwise = parseJSON o+emptyObject _ = return Nothing++instance FromJSON v => FromJSON (TombstoneItem v) where+ parseJSON (Object o) = do+ let path = o .: "path"+ reftime = o .: "reftime"+ (Object p) <- o .: "path"+ tombstone <- p .:? "tombstone"+ case tombstone of+ Just (Bool True) -> TombstoneItem <$> path <*> reftime+ _ -> LiveItem <$> path <*> (emptyObject =<< o .:? "value") <*> reftime+ parseJSON _ = mzero++-- | A single search item.+data SearchItem v = SearchItem+ { _searchItem :: !(ResultItem Path v)+ -- ^ The path to the item and the item itself.+ , _searchScore :: !Double+ -- ^ The item's relevancy to the query.+ } deriving (Show)+$(makeLenses ''SearchItem)++instance FromJSON v => FromJSON (SearchItem v) where+ parseJSON o'@(Object o) = SearchItem+ <$> parseJSON o'+ <*> o .: "score"+ parseJSON _ = mzero++-- | The collection of search results.+data SearchList v = SearchList+ { _searchResults :: !(ResultList (SearchItem v))+ -- ^ The list of search results.+ , _searchTotal :: !Int+ -- ^ The total number of hits for the search. This may be+ -- more than the number of results returned.+ } deriving (Show)+$(makeLenses ''SearchList)++instance FromJSON v => FromJSON (SearchList v) where+ parseJSON o'@(Object o) = SearchList+ <$> parseJSON o'+ <*> o .: "total_count"+ parseJSON _ = mzero++-- | A list of events returned by 'listEvents'.+--+-- This data type uses two parameters:+--+-- [@a@] The type of data being stored for the event.+--+-- [@b@] A phantom type for the type of data associated with the event.+-- This data must also be stored in Orchestrate using the+-- "Database.Orchestrate.KeyValue" API.+type EventList a b = ResultList (EventItem a b)++-- | A list of edges returned by 'getRel'.+--+-- This datatype uses two parameters:+--+-- [@a@] The data type for the edge's origin node.+-- [@b@] The data type for the edge's target node.+type RelList a b = ResultList (ResultItem Path b)++-- | A list of data returned by 'listV'.+--+-- [@v@] The type of the data contained in the list.+type KVList v = ResultList (ResultItem Path v)
+ src/Database/Orchestrate/Utils.hs view
@@ -0,0 +1,338 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wall #-}+++module Database.Orchestrate.Utils+ (+ -- * Type Utilities+ -- ** Executing 'OrchestrateIO' Actions+ runO+ , runO'+ -- ** Lifting+ , orchestrateEither+ , io++ -- * API Infrastructure+ , api+ , api'+ , api404+ , apiCheck+ , apiCheckDecode++ -- * API Functions+ , ping++ -- * Data Type Helpers+ -- ** Session Utilities+ , baseUrl+ , buildUrl+ , withAuth'+ , withAuth+ , envSession++ -- ** Match Utilities+ , ifMatch+ , ifMatch'++ -- ** 'Location' Prisms and Functions+ , locationCollection+ , locationKey+ , locationRef+ , locationType+ , locationTimestamp+ , locationOrdinal+ , getLocation++ -- ** Range Utilities+ , rangeStart+ , rangeEnd++ -- * General Utilities+ , rot+ , tshow+ , initTail+ ) where+++import Control.Applicative+import Control.Error+import Control.Exception as Ex+import Control.Lens+import Control.Monad.Error.Class+import Control.Monad.Reader+import Data.Aeson+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Lazy as BSL+import Data.Default+import qualified Data.List as L+import Data.Monoid+import qualified Data.Text as T+import qualified Data.Text.Encoding as E+import qualified Data.Text.Read as TR+import Network.HTTP.Client hiding (responseBody)+import Network.HTTP.Types+import Network.Wreq+import Network.Wreq.Types hiding (auth, headers, params)+import System.Environment++import Database.Orchestrate.Network+import Database.Orchestrate.Types+++-- | Pings the Orchestrate API.+ping :: OrchestrateIO ()+ping = checkResponse =<< api [] [] [] headWith++-- | Run an 'OrchestrateT' action with a 'Session' that does /not/ include+-- authentication. This function will add proper authentication before+-- running the action.+runO :: Monad m => OrchestrateT m a -> Session -> m (Either Ex.SomeException a)+runO m s = runO' m $ over sessionOptions (withAuth $ s ^. sessionKey) s++-- | Run an 'OrchestrateT' action with a 'Session' that already includes+-- authentication.+--+-- This is the most minimal handler.+runO' :: Monad m => OrchestrateT m a -> Session -> m (Either Ex.SomeException a)+runO' m = runReaderT (runEitherT $ runOrchestrate m)++-- | Lifts an IO action into the 'OrchestrateT' monad.+io :: MonadIO m => IO a -> OrchestrateT m a+io = OrchestrateT . syncIO++-- | Lifts an 'Either' value into the 'OrchestrateT' monad.+orchestrateEither :: Monad m+ => Either Ex.SomeException a -> OrchestrateT m a+orchestrateEither = OrchestrateT . hoistEither++-- | Create the base Orchestrate API URL given the current 'Session'.+baseUrl :: Monad m => OrchestrateT m T.Text+baseUrl = do+ Session{..} <- ask+ return $ mconcat [_sessionURL, "/v", tshow _sessionVersion]++-- | Adds the API key to the default 'Options'.+withAuth' :: APIKey -> Options+withAuth' key = withAuth key defaults++-- | Adds the API key to a set of wreq 'Options'.+withAuth :: APIKey -> Options -> Options+withAuth key o = o & auth .~ basicAuth (E.encodeUtf8 key) ""++-- | Builds a URL from its assembled parts.+buildUrl :: Monad m+ => [T.Text] -- ^ The parts of the URL path. These are joined by @/@.+ -> OrchestrateT m String -- ^ Returns the URL as a 'String'.+buildUrl paths = do+ Session{_sessionURL, _sessionVersion} <- ask+ return . T.unpack+ . E.decodeUtf8+ . BSL.toStrict+ . B.toLazyByteString+ . mconcat+ . mappend [ textb _sessionURL+ , "/v", B.intDec _sessionVersion+ , "/"+ ]+ . L.intersperse "/"+ $ map textb paths+ where textb = B.byteString . E.encodeUtf8++augmentOptions :: RequestHeaders -> [FormParam] -> Options -> Options+augmentOptions hdrs pairs o = o & headers .~ hdrs+ & params .~ map pair pairs+ where bstext = E.decodeUtf8+ pair (k := v) = (bstext k, bstext $ renderFormValue v)++-- | This assembles and performs an API call.+api :: RequestHeaders -- ^ Additional HTTP headers.+ -> [T.Text] -- ^ The parts of the URL path.+ -> [FormParam] -- ^ The form parameters.+ -> RestCall a -- ^ The wreq function to make the call.+ -> OrchestrateIO (Response a) -- ^ Returns the call's response.+api hdrs paths pairs f = do+ opts <- views sessionOptions $ augmentOptions hdrs pairs+ io . f opts =<< buildUrl paths++-- | This assembles and peforms an API call, lifting any status code errors+-- out of the monad and returning them in an explicit 'Either'.+api' :: RequestHeaders -- ^ Additional HTTP headers.+ -> [T.Text] -- ^ The parts of the URL path.+ -> [FormParam] -- ^ The form parameters.+ -> RestCall a -- ^ The wreq function to make the call.+ -> OrchestrateIO (Either Status (Response a))+ -- ^ Returns either the error status or+ -- the response.+api' hdrs paths pairs f = do+ opts <- views sessionOptions $ augmentOptions hdrs pairs+ url <- buildUrl paths+ io $ fmap Right (f opts url) `Ex.catch` handler+ where handler (StatusCodeException s _ _) = return $ Left s+ handler e = throwIO e++-- | This assembles and performs an API call and checks that the status+-- passes 'checkResponse'.+apiCheck :: RequestHeaders -- ^ Additional HTTP headers.+ -> [T.Text] -- ^ The parts of the URL path.+ -> [FormParam] -- ^ The form parameters.+ -> RestCall a -- ^ The wreq function to make the call.+ -> OrchestrateIO (Response a) -- ^ Returns the verified response.+apiCheck rh rpath rparams handler = do+ r <- api rh rpath rparams handler+ checkResponse r+ return r++-- | This assembles and performs an API call. Afterward it checks the+-- status code and decodes the JSON response.+apiCheckDecode :: FromJSON a+ => RequestHeaders -- ^ Additional HTTP headers.+ -> [T.Text] -- ^ The parts of the URL path.+ -> [FormParam] -- ^ The form parameters.+ -> RestCall BSL.ByteString -- ^ The wreq function to make the call.+ -> OrchestrateIO a -- ^ Returns the verified, decoded response.+apiCheckDecode rh rpath rparams handler =+ apiCheck rh rpath rparams handler+ >>= orchestrateEither . fmapL errex . eitherDecode . (^. responseBody)+ where errex = Ex.SomeException . Ex.ErrorCall++-- | This assembles and performs an API call. It returns 'Nothing' if the+-- call returns a 404 status code.+api404 :: Show a+ => RequestHeaders -- ^ Additional HTTP headers.+ -> [T.Text] -- ^ The parts of the URL path.+ -> [FormParam] -- ^ The form parameters.+ -> RestCall a -- ^ The wreq function to make the call.+ -> OrchestrateIO (Maybe (Response a)) -- ^ Returns maybe the response.+api404 hdrs pths parms f = do+ s <- ask+ er <- liftIO $ Ex.catchJust+ Ex.fromException+ (fmapL filterStatusCode <$> runO' (api hdrs pths parms f) s)+ handler+ case er of+ Right r -> checkResponse r >> return (Just r)+ Left (Just (StatusCodeException (Status 404 _) _ _)) -> return Nothing+ Left (Just e) -> throwSome e+ Left Nothing -> throwSome $ StatusCodeException status418 [] mempty++ where+ handler :: HttpException -> IO (Either (Maybe HttpException) a)+ handler e@(StatusCodeException{}) = return . Left $ Just e+ handler e = Ex.throw e++ onlyStatusCode :: HttpException -> Maybe HttpException+ onlyStatusCode e@(StatusCodeException{}) = Just e+ onlyStatusCode _ = Nothing++ filterStatusCode :: Ex.SomeException -> Maybe HttpException+ filterStatusCode = join . fmap onlyStatusCode . Ex.fromException++ throwSome :: (Ex.Exception e, Monad m, MonadError Ex.SomeException m)+ => e -> m a+ throwSome = throwError . Ex.SomeException++-- | This returns the 'Session' with the API key taken from the+-- @ORCHESTRATE_API@ environment variable.+--+-- The value of 'sessionOptions' will include authentication.+envSession :: IO Session+envSession = do+ key <- T.pack <$> getEnv "ORCHESTRATE_API"+ return $ def & sessionKey .~ key+ & over sessionOptions (withAuth key)++-- | This takes a three-parameter function and rotates the parameters to+-- return a function that takes the third parameter first.+rot :: (a -> b -> c -> d) -> c -> a -> b -> d+rot f c a b = f a b c++-- | Takes an 'IfMatch'' and returns a list of request headers.+ifMatch' :: IfMatch' -> [Header]+ifMatch' (Just r) = [("If-Match", E.encodeUtf8 r)]+ifMatch' Nothing = []++-- | Takes an 'IfMatch' and returns a list of request headers.+ifMatch :: IfMatch -> [Header]+ifMatch (IfMatch r) = [("If-Match", E.encodeUtf8 r)]+ifMatch (IfNoneMatch r) = [("If-None-Match", E.encodeUtf8 r)]+ifMatch NoMatch = []++loc :: Int -> Prism' T.Text T.Text+loc n = prism' (mappend $ T.replicate (n - 1) "/")+ ((`atMay` n) . T.split (=='/'))++locint :: (Integral i, Show i) => Int -> Prism' T.Text i+locint n = prism' (mappend prefix . T.pack . show)+ ( join+ . fmap (hush . fmap fst . TR.decimal)+ . (`atMay` n)+ . T.split (=='/'))+ where prefix = T.replicate (n - 1) "/"++-- | A prism over the collection part of a 'Location' URL.+locationCollection :: Prism' T.Text T.Text+locationCollection = loc 2++-- | A prism over the key part of a 'Location' URL.+locationKey :: Prism' T.Text T.Text+locationKey = loc 3++-- | A prism over the ref part of a 'Location' URL.+locationRef :: Prism' T.Text T.Text+locationRef = loc 5++-- | A prism over the type part of a 'Location' URL from an event+-- operation.+locationType :: Prism' T.Text T.Text+locationType = loc 5++-- | A prism over the timestamp part of a 'Location' URL from an event+-- operation.+locationTimestamp :: Prism' T.Text Integer+locationTimestamp = locint 6++-- | A prism over the ordinal part of a 'Location' URL from an event+-- operation.+locationOrdinal :: Prism' T.Text Int+locationOrdinal = locint 7++-- | Retrieves the 'Location' from a response's headers.+getLocation :: Response a -> T.Text+getLocation = E.decodeUtf8 . view (responseHeader "Location")++-- | Given a starting 'RangeEnd', return the form parameter.+rangeStart :: FormValue a+ => BS.ByteString -- ^ The suffix for the form parameter.+ -> RangeEnd a -- ^ The 'RangeEnd'.+ -> Maybe FormParam -- ^ Returns the form parameter.+rangeStart k (Inclusive r) = Just $ ("start" <> k) := r+rangeStart k (Exclusive r) = Just $ ("after" <> k) := r+rangeStart _ Open = Nothing++-- | Given an ending 'RangeEnd', return the form parameter.+rangeEnd :: FormValue a+ => BS.ByteString -- ^ The suffix for the form parameter.+ -> RangeEnd a -- ^ The 'RangeEnd'.+ -> Maybe FormParam -- ^ Returns the form parameter.+rangeEnd k (Inclusive r) = Just $ ("end" <> k) := r+rangeEnd k (Exclusive r) = Just $ ("before" <> k) := r+rangeEnd _ Open = Nothing++-- | Show data as 'T.Text'.+tshow :: Show a => a -> T.Text+tshow = T.pack . show++-- | Returns both the last item in a list and the list's 'init'.+--+-- If the list is empty, it will return @(Nothing, [])@. Otherwise, it's an+-- optimized call to @(lastMay &&& initSafe)@.+initTail :: [a] -> (Maybe a, [a])+initTail [] = (Nothing, [])+initTail [x] = (Just x, [])+initTail (x:xs) = (x:) <$> initTail xs