pokitdok (empty) → 4.1.0.0
raw patch · 8 files changed
+940/−0 lines, 8 filesdep +HTTPdep +aesondep +basesetup-changed
Dependencies added: HTTP, aeson, base, base64-string, bytestring, case-insensitive, directory, hex, http-client, http-conduit, http-types, strict, text, time
Files
- LICENSE.txt +21/−0
- PokitDok.hs +76/−0
- PokitDok/Client.hs +301/−0
- PokitDok/OAuth2.hs +290/−0
- PokitDok/Paths.hs +31/−0
- PokitDok/Requests.hs +163/−0
- Setup.hs +2/−0
- pokitdok.cabal +56/−0
+ LICENSE.txt view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2014 PokitDok, Inc.++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ PokitDok.hs view
@@ -0,0 +1,76 @@+-----------------------------------------------------------------------------+-- |+-- Module : PokitDok+-- Version : PokitDok Platform API v4+-- Copyright : (c) PokitDok Inc., 2011-2015+-- License : see LICENSE.txt+-- +-- Maintainer : gage.swenson@pokitdok.com+-- Stability : internal+-- Portability : non-portable+--+-- Exports every call in the+-- PokitDok.Client module.+--+-----------------------------------------------------------------------------++-- The PokitDok module enables a Haskell programmer to make PokitDok API+-- calls from within the Haskell platform. The usage principles are concise+-- and easy to implement.+--+-- 1. A client creates an @'OAuth2'@ by calling @'keyWithIdSecret'@,+-- given their API secret key and credentials. This datum stores an id,+-- secret, callback url, and access token, along with the lesser meddled+-- with authorize endpoint and access token endpoint.+--+-- 2. A client refreshes their OAuth's access token by calling @'refresh'@+-- With an id and secret, one can fetch access token data from the API.+-- To call the API, a fresh (not expired) access token is required.+-- @'keyModCallback'@, @'authorizationUrl'@, and @'authenticateCode'@+-- are helpful for developers working with PokitDok accounts in context.+--+-- 3. Make API calls with the refreshed OAuth2. Most tokens last for 3600+-- seconds. It is safe to call refresh before every API call because a+-- token will only refresh if it is expired. If you authenticated with+-- a code and have a refresh token, it is more safe to store the result+-- of every @'refresh'@ so that you use the latest issued token.+-- +-- +-- Sample usage:+-- >+-- > -- Each call returns an IO String.+-- > -- Each string contains a json object+-- >+-- > import PokitDok+-- > +-- > main :: IO ()+-- > main = do+-- > -- id and secret credentials to access the API+-- > putStrLn "Enter your PokitDok API ID:"+-- > id <- getLine+-- > putStrLn "Enter your secret key:"+-- > secret <- getLine+-- > pd <- refresh $ keyWithIdSecet id secret+-- >+-- > -- retrieve provider information by NPI+-- > providersWithNpi pd "1467560003" >>= putStrLn+-- > +-- > -- retrieve cash price information by zip and CPT code+-- > cashPriceJson <- pricesCash pd [("zip_code","85255"),("cpt_code","87799")]+-- > putStrLn cashPriceJson+-- >+-- > -- a sample usage of readFile with an API call+-- > readFile "postdata.json" >>= claims pd+-- >+-- > -- an example of a non persistent refresh with an API call+-- > refresh pd >>= (flip activitiesWithId) "5362b5a064da150ef6f2526c"+-- >+-- > -- an example of a persistent refresh+-- > pd1 <- refresh pd+-- > return ()+--++module PokitDok+ ( module PokitDok.Client+ ) where+import PokitDok.Client
+ PokitDok/Client.hs view
@@ -0,0 +1,301 @@+-- | This module contains everything you need to +-- perform PokitDok Platform API calls.++module PokitDok.Client where++import PokitDok.Requests+import PokitDok.OAuth2+import PokitDok.Paths+++-- | Generates a new key with a given id and secret.+keyWithIdSecret :: String -> String -> OAuth2+keyWithIdSecret id secret = OAuth2+ { oauthClientId = id+ , oauthClientSecret = secret+ , oauthAccessTokenEndpoint = apiSite ++ apiTokenPath+ , oauthOAuthorizeEndpoint = Just $ apiSite ++ apiEndpointAuthorizations+ , oauthCallback = Nothing+ , oauthAccessToken = Nothing+ }++-- | Modifies the given key's callback url with the given @'Maybe'@ @'String'@'s value.+keyModCallback :: OAuth2 -> Maybe String -> OAuth2+keyModCallback oauth n@Nothing = oauth { oauthCallback = n }+keyModCallback oauth j = oauth { oauthCallback = j }++-- | A url where a user can obtain an access token.+-- Throws an error unless @keyModCallback@ is used on the credential.+authorizationUrl :: OAuth2 -> String+authorizationUrl (OAuth2 id sec _ (Just authEP) (Just cb) _) =+ authEP `appendParams` authorizationUrlParams+ where+ authorizationUrlParams =+ [ ("client_id" , id)+ , ("response_type", "code")+ , ("redirect_uri" , cb)+ , ("scope" , "user_schedule")+ ]+authorizationUrl _ = error "Cannot generate authoirzation url without a callback url."++-- | Checks if the given @OAuth2@'s @AccessToken@ is expired.+isExpired :: OAuth2 -> IO Bool+isExpired (OAuth2 _ _ _ _ _ (Just at)) = isExpired' at+isExpired _ = return True++-- | Takes an @OAuth2@ and returns an @IO@ @OAuth2@ with a valid @AccessToken@.+refresh :: OAuth2 -> IO OAuth2+refresh auth = isExpired auth >>= refreshExpired auth++-- | Authenticate's an OAuth2 with the given authorization code.+authenticateCode :: OAuth2 -> String -> IO OAuth2+authenticateCode = activateKeyWithAuthCode+++-- | Call the activities endpoint for a specific activityId.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#activities+activitiesWithId+ :: OAuth2 -- ^ Credentials with a valid @'AccessToken'@+ -> String -- ^ Activity identifier.+ -> IO String -- ^ JSON formatted data.+activitiesWithId auth id = assertValid auth >> + pokitdokGetRequest auth url [] >>= getJSONIO+ where url = path ++ apiEndpointActivities ++ id++-- | Call the activities endpoint to get a listing of current activities,+-- a query string parameter ‘parent_id’ may also be used with this API to get information about+-- sub-activities that were initiated from a batch file upload.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#activities+activities+ :: OAuth2+ -> Parameters -- ^ _id, name, callback_url, file_url, history, state, transition_path...+ -> IO String+activities auth params = assertValid auth >> + pokitdokGetRequest auth url params >>= getJSONIO+ where url = path ++ apiEndpointActivities++-- | Return a list of cash prices for a given procedure+-- (by CPT Code) in a given region (by ZIP Code).+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#cashprices+pricesCash+ :: OAuth2+ -> Parameters -- ^ cpt_code, zip_code (wthin with to search)+ -> IO String+pricesCash auth params = assertValid auth >> + pokitdokGetRequest auth url params >>= getJSONIO+ where url = path ++ apiEndpointPriceCash++-- | Return a list of insurance prices for a given procedure+-- (by CPT Code) in a given region (by ZIP Code).+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#insuranceprices+pricesInsurance+ :: OAuth2+ -> Parameters -- ^ cpt_code, zip_code+ -> IO String+pricesInsurance auth params = assertValid auth >> + pokitdokGetRequest auth url params >>= getJSONIO+ where url = path ++ apiEndpointPriceInsurance++-- | Create a new claim, via the filing of an EDI 837 Professional Claims, to the designated Payer.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#claims+claims+ :: OAuth2+ -> String -- ^ Dictionary representing JSON post data.+ -> IO String+claims auth json = assertValid auth >> + pokitdokPostRequest auth url json >>= getJSONIO+ where url = path ++ apiEndpointClaims++-- | Ascertain the status of the specified claim, via the filing of an EDI 276 Claims Status.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#claimstatus+claimsStatus :: OAuth2 -> String -> IO String+claimsStatus auth json = assertValid auth >> + pokitdokPostRequest auth url json >>= getJSONIO+ where url = path ++ apiEndpointClaimsStatus++-- | Determine eligibility via an EDI 270 Request For Eligibility.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#eligibility+eligibility+ :: OAuth2+ -> String -- Dictionary representing an EDI 270 Request For Eligibility, JSON.+ -> IO String+eligibility auth json = assertValid auth >> + pokitdokPostRequest auth url json >>= getJSONIO+ where url = path ++ apiEndpointEligibility++-- | File an EDI 834 benefit enrollment.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#enrollment+enrollment+ :: OAuth2+ -> String -- ^ Post data, JSON.+ -> IO String+enrollment auth json = assertValid auth >> + pokitdokPostRequest auth url json >>= getJSONIO+ where url = path ++ apiEndpointEnrollment++-- | Retrieve providers data matching specified query parameters+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#providers+providers+ :: OAuth2+ -> Parameters -- ^ organization_name, first_name, last_name, specialty, city, state, radius...+ -> IO String+providers auth params = assertValid auth >> + pokitdokGetRequest auth url params >>= getJSONIO+ where url = path ++ apiEndpointProviders++-- | Retrieve the data for a specified provider.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#providers+providersWithNpi+ :: OAuth2+ -> String -- Provider NPI identifier, JSON.+ -> IO String+providersWithNpi auth npi = assertValid auth >> + pokitdokGetRequest auth url [] >>= getJSONIO+ where url = path ++ apiEndpointProviders++npi++-- | Retrieve data on plans based on the parameters given.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#plans+plans+ :: OAuth2+ -> Parameters -- ^ trading_partner_id, country, state, plan_id, plan_type, plan_name...+ -> IO String+plans auth params = assertValid auth >> + pokitdokGetRequest auth url params >>= getJSONIO+ where url = path ++ apiEndpointPlans++-- | Use the /payers/ API to determine available payer_id values for use with other endpoints+-- The Payers endpoint will be deprecated in v5. Use Trading Partners instead.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#payers+payers :: OAuth2 -> IO String+payers auth = assertValid auth >> + pokitdokGetRequest auth url [] >>= getJSONIO+ where url = path ++ apiEndpointPayers++-- | Retrieve a list of trading partners or submit an id to get info for a+-- specific trading partner. Empty string is a valid parameter.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#tradingpartners+tradingPartners+ :: OAuth2+ -> String -- Trading Partner Identifier, can be empty.+ -> IO String+tradingPartners auth id = assertValid auth >> + pokitdokGetRequest auth url [] >>= getJSONIO+ where url = path++apiEndpointTradingPartners++id++-- | Submit X12 formatted EDI file for batch processing.+-- If the callback url is not nothing in the @'OAuth2'@, it will be included.+files+ :: OAuth2+ -> String -- ^ Trading_partner_id.+ -> String -- ^ Full filesytem path of file to be submitted.+ -> IO String+files auth trPartId filePath = assertValid auth >> do+ let postData = ("trading_partner_id",trPartId) :+ case oauthCallback auth of+ (Just cb) -> [("callback_url",cb)]+ otherwise -> []+ pokitdokMultipartRequest auth url postData filePath >>= getJSONIO+ where url = path ++ apiEndpointFiles++-- | Request approval for a referral to another health care provider.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#referrals+referrals :: OAuth2 -> String -> IO String+referrals auth json = assertValid auth >> + pokitdokPostRequest auth url json >>= getJSONIO+ where url = path ++ apiEndpointReferrals++-- | Submit an authorization request.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#authorizations+authorizations+ :: OAuth2+ -> String -- Dictionary representing JSON post data.+ -> IO String+authorizations auth json = assertValid auth >> + pokitdokPostRequest auth url json >>= getJSONIO+ where url = path ++ apiEndpointAuthorizations++-- | Get a list of supported scheduling systems and their UUIDs and descriptions.+schedulers+ :: OAuth2+ -> String -- ^ Optional (can be ""), retrieve the data for a specified scheduling system.+ -> IO String+schedulers auth uuid = assertValid auth >> + pokitdokGetRequest auth url [] >>= getJSONIO+ where url = path ++ apiEndpointSchedulers ++ uuid++-- | Get a list of appointment types, their UUIDs, and descriptions.+appointmentTypes+ :: OAuth2+ -> String -- ^ Optional (""), retrieve the data for a specified appointment type.+ -> IO String+appointmentTypes auth uuid = assertValid auth >> + pokitdokGetRequest auth url [] >>= getJSONIO+ where url = path ++ apiEndpointAppointmentTypes ++ uuid++-- | Create an available appointment slot in the PokitDok scheduler system.+createSlot+ :: OAuth2+ -> String -- ^ Available appointment slot details, JSON.+ -> IO String+createSlot auth json = assertValid auth >> + pokitdokPostRequest auth url json >>= getJSONIO+ where url = path ++ apiEndpointSlots++-- | Query for an open appointment slot or a booked appointment given a+-- specific pd_appointment_uuid, the (PokitDok unique appointment identifier).+-- See https://platform.pokitdok.com/documentation+appointmentsWithId+ :: OAuth2+ -> String -- ^ The PokitDok unique appointment identifier.+ -> IO String+appointmentsWithId auth uuid = assertValid auth >> + pokitdokGetRequest auth url [] >>= getJSONIO+ where url = path ++ apiEndpointAppointments ++ uuid++-- | Query for open appointment slots (using pd_provider_uuid and location)+-- or booked appointments (using patient_uuid) given query parameters.+-- See https://platform.pokitdok.com/documentation+appointments :: OAuth2 -> Parameters -> IO String+appointments auth params = assertValid auth >> + pokitdokGetRequest auth url params >>= getJSONIO+ where url = path ++ apiEndpointAppointments++-- | Book appointment for an open slot. Post data contains patient+-- attributes and description.+-- See https://platform.pokitdok.com/documentation+bookAppointment+ :: OAuth2+ -> String -- ^ The PokitDok unique appointment identifier.+ -> String -- ^ Put data, JSON.+ -> IO String+bookAppointment auth uuid json = assertValid auth >> + pokitdokPutRequest auth url json >>= getJSONIO+ where url = path ++ apiEndpointAppointments ++ uuid++-- | Update appointment description.+-- See https://platform.pokitdok.com/documentation+updateAppointment :: OAuth2 -> String -> String -> IO String+updateAppointment auth uuid json = assertValid auth >> + pokitdokPutRequest auth url json >>= getJSONIO+ where url = path ++ apiEndpointAppointments ++ uuid++-- | Cancel appointment given its pd_appointment_uuid.+-- See https://platform.pokitdok.com/documentation +cancelAppointment :: OAuth2 -> String -> IO String+cancelAppointment auth uuid = assertValid auth >> + pokitdokDeleteRequest auth url >>= getJSONIO+ where url = path ++ apiEndpointAppointments ++ uuid++{--- | Get a list of medical procedure information meeting certain+-- search criteria.+-- See docs here: https://platform.pokitdok.com/documentation/v4#/#mpc+medicalProcedureCode :: OAuth2 -> Parameters -> IO String+medicalProcedureCode auth params = assertValid auth >>+ pokitdokGetRequest auth url params >>= getJSONIO+ where url = path ++ apiEndpointMPC++-- | Retrieve the data for a specific procedure code.+medicalProcedureCodeWithMPC :: OAuth2 -> String -> IO String+medicalProcedureCodeWithMPC auth mpc = assertValid auth >>+ pokitdokGetRequest auth url >>= getJSONIO+ where url = path ++ apiEndpointMPC ++ mpc-}
+ PokitDok/OAuth2.hs view
@@ -0,0 +1,290 @@+-- | This module provides the core functionality+-- that connects to the specified API and performs+-- generic GET, POST, PUT, and DELETE requests.+-- +-- Powered by the Network.HTTP.Conduit (http-conduit) package.++module PokitDok.OAuth2+ ( OAuth2(..)+ , AccessToken(..)+ , ResponseData(..)+ , Parameters+ , keyModAccessToken+ , authenticateClientCredentials+ , authenticateAuthorizationCode+ , authenticateRefreshToken+ , getRequest+ , deleteRequest+ , postRequest+ , multipartRequest+ , putRequest+ , makeUserAgentHeader+ , makeContentHeader+ , makeAuthHeader+ , appendParams+ ) where++import qualified Data.Text as T+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Codec.Binary.Base64.String as B64++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.CaseInsensitive (foldCase, mk)+import Data.Time.Calendar (fromGregorian)+import Network.HTTP.Conduit+ ( Response+ , Request(method, requestHeaders, requestBody)+ , RequestBody(RequestBodyBS)+ , parseUrl+ , urlEncodedBody+ , httpLbs+ , withManager+ , responseBody+ , responseStatus+ , responseHeaders+ )+import Network.HTTP.Client.MultipartFormData+ ( Part+ , partBS+ , partFile+ , formDataBodyWithBoundary+ )+import Network.HTTP.Types (statusCode)+import Network.HTTP.Types.Header (Header)+import Network.HTTP.Base (urlEncode)+import Data.Aeson+import Data.Maybe (fromJust)++type Parameters = [(String, String)]+type Headers = [(String, String)]++-- | Stores OAuth2 data.+data OAuth2 = OAuth2+ { oauthClientId :: String+ , oauthClientSecret :: String+ , oauthAccessTokenEndpoint :: String+ , oauthOAuthorizeEndpoint :: Maybe String+ , oauthCallback :: Maybe String+ , oauthAccessToken :: Maybe AccessToken+ } deriving (Show, Eq)+ ++-- | OAuth access token.+data AccessToken = AccessToken+ { accessToken :: String+ , refreshToken :: Maybe String+ , expires :: Maybe Int -- ^ POSIX seconds.+ , expiresIn :: Maybe Int+ , token_type :: Maybe String+ } deriving (Show, Eq)++-- | Stores http response headers, body and status code.+data ResponseData = ResponseData+ { headers :: Headers+ , body :: String+ , status :: Int+ } deriving Show++instance FromJSON AccessToken where+ parseJSON (Object o) = AccessToken <$> at <*> rt <*> ex <*> ei <*> tt+ where+ at = o .: T.pack "access_token"+ rt = o .:? T.pack "refresh_token"+ ex = o .:? T.pack "expires"+ ei = o .:? T.pack "expires_in"+ tt = o .: T.pack "token_type"+ parseJSON _ = mzero++-- Functions dealing with authorization, access tokens, and authentication.++-- | Modifies the given key's @AccessToken@ with the given @'Maybe'@ @AccessToken@'s value.+keyModAccessToken :: OAuth2 -> Maybe AccessToken -> OAuth2+keyModAccessToken oauth n@Nothing = oauth { oauthAccessToken = n }+keyModAccessToken oauth j = oauth { oauthAccessToken = j }++-- | Takes a request and returns an access token or errors.+authenticateRequest :: Request -> IO AccessToken+authenticateRequest request = do+ response <- getResponse request+ let maybeToken = decode $ responseBody response+ case maybeToken of+ Nothing -> error $ "***** Error decoding response:\n"++show response+ Just token -> return token++-- | Returns a valid @AccessCode@ given some headers and an @OAuth2@.+authenticateClientCredentials :: Headers -> OAuth2 -> IO AccessToken+authenticateClientCredentials headers auth@(OAuth2 _ _ url _ _ _) = do+ req <- makeRegularPostRequest url $ makeHeaders headers+ authenticateRequest $ urlEncodedBody clientCredentialParams req+ where+ clientCredentialParams = map strToBS $+ [ ("grant_type" , "client_credentials")+ , ("client_id" , oauthClientId auth)+ , ("client_secret", oauthClientSecret auth)+ ]++-- | Returns an @AccessToken@ given some headers, an @OAuth2@, and an authorization code.+authenticateAuthorizationCode :: Headers -> OAuth2 -> String -> IO AccessToken+authenticateAuthorizationCode headers auth@(OAuth2 _ _ url _ _ _) code = do+ req <- makeRegularPostRequest url $ makeHeaders headers+ authenticateRequest $ urlEncodedBody authorizationCodeParams req+ where+ authorizationCodeParams = map strToBS $+ [ ("grant_type" , "authorization_code")+ , ("client_id" , oauthClientId auth)+ , ("client_secret", oauthClientSecret auth)+ , ("redirect_uri" , fromJust $ oauthCallback auth)+ , ("code" , code)+ , ("scope" , "user_schedule")+ ]++-- | Takes @OAuth2@ data and returns a refreshed @AccessToken@.+authenticateRefreshToken :: Headers -> OAuth2 -> IO AccessToken+authenticateRefreshToken h a@(OAuth2 id sec url _ _ (Just (AccessToken _ (Just rt) _ _ _))) = do+ let parameters = map strToBS refreshTokenParams+ req <- makeRegularPostRequest url $ makeHeaders h+ authenticateRequest req+ where+ refreshTokenParams =+ [ ("grant_type" , "refresh_token")+ , ("client_id" , id)+ , ("client_secret", sec)+ , ("refresh_token", rt)+ , ("scope" , "user_schedle")+ ]++-- Functions that perform network calls.++-- | Perform a GET request given request headers, a url, and query parameters.+getRequest :: Headers -> String -> Parameters -> IO ResponseData+getRequest headers url params = do+ req <- makeGetRequest (appendParams url params) $ makeHeaders headers + handleRequest req++-- | Perform a DELETE request, given some headers, for the given resource.+deleteRequest :: Headers -> String -> IO ResponseData+deleteRequest headers url =+ makeDeleteRequest url (makeHeaders headers) >>= handleRequest++-- | Perform a POST request given request headers, a url, and request body.+postRequest :: Headers -> String -> String -> IO ResponseData+postRequest headers url body = do+ req <- makePostRequest url $ makeHeaders headers+ handleRequest $ req { requestBody = RequestBodyBS $ BS.pack body }++-- | Performs a multipart request given a body and a boundary+-- separating the requests in the body.+multipartRequest+ :: Headers -- ^ Some headers, must include authorization.+ -> String -- ^ Request URL.+ -> Parameters -- ^ Multipart parameters.+ -> String -- ^ Post file path.+ -> String -- ^ The boundary for each of the headers.+ -> IO ResponseData+multipartRequest headers url params path boundary = do+ let part0 = partFile (T.pack "file") path+ parts = makeMultipartParts params ++ [part0]+ req <- parseUrl url >>= formDataBodyWithBoundary (BS.pack boundary) parts+ handleRequest $ req { requestHeaders = requestHeaders req ++ makeHeaders headers }+ ++-- | Perform a PUT request given request headers, a url, and a request body.+putRequest :: Headers -> String -> String -> IO ResponseData+putRequest headers url body = do+ req <- makePutRequest url $ makeHeaders headers+ handleRequest $ req { requestBody = RequestBodyBS $ BS.pack body }++-- Handles a request and returns some response data.+handleRequest :: Request -> IO ResponseData+handleRequest req = do+ resp <- getResponse req+ return $ ResponseData + { headers = map showpair $ responseHeaders resp+ , body = BSL.unpack $ responseBody resp+ , status = statusCode $ responseStatus resp+ }+ where+ showpair (a, b) = (show a, show b)++-- Turns a request into a response.+getResponse :: Request -> IO (Response BSL.ByteString)+getResponse = withManager . httpLbs++-- Auxiliary functions for headers and parameters.++-- | Makes a header out of a given header name and value tuple.+makeHeader :: (String, String) -> Header+makeHeader (key, val) = (toCI key, BS.pack val)+ where+ toCI = mk . foldCase . BS.pack++-- | Maps makeHeader to a list of header tuples.+makeHeaders :: Headers -> [Header]+makeHeaders = map makeHeader++-- | Returns a user agent tuple with the specified user agent.+makeUserAgentHeader :: String -> (String,String)+makeUserAgentHeader str = ("User-Agent" , str)+-- | Returns an authorization tuple with the specified authorization string.+makeAuthHeader :: String -> (String,String)+makeAuthHeader str = ("Authorization", str)+-- | Returns a content type tuple with the specified content type.+makeContentHeader :: String -> (String,String)+makeContentHeader str = ("Content-Type" , str)++-- | Takes a url and appends the parameters to form a query url.+appendParams :: String -> Parameters -> String+appendParams url ((k,v):ps)+ | '?' `elem` url = appendParams (url ++ "&" ++ k ++ "=" ++ urlEncode v) ps+ | otherwise = appendParams (url ++ "?" ++ k ++ "=" ++ urlEncode v) ps+appendParams url [] = url++-- | A map from String tuple to ByteString tuple.+strToBS :: (String,String) -> (BS.ByteString,BS.ByteString)+strToBS (a,b) = (BS.pack a,BS.pack b)++-- Functions that return a respectively formatted request.++-- Returns a get request given a url and some headers.+makeGetRequest :: String -> [Header] -> IO Request+makeGetRequest uri headers = do+ req <- parseUrl uri+ return $ req+ { requestHeaders = makeHeader contentHeader : headers+ }+ where+ contentHeader = makeContentHeader "application/x-www-form-urlencoded"++-- Makes the @makeGetRequest@ a DELETE request.+makeDeleteRequest :: String -> [Header] -> IO Request+makeDeleteRequest uri headers = do+ req <- makeGetRequest uri headers+ return $ req { method = BS.pack "DELETE" }++-- Makes the @makeRegularPostRequest@ a json POST request.+makePostRequest :: String -> [Header] -> IO Request+makePostRequest uri headers = do+ req <- makeRegularPostRequest uri headers+ return $ req+ { requestHeaders = (makeHeader $ makeContentHeader "application/json") + : headers+ }++-- Makes the @makeGetRequest@ a POST request.+makeRegularPostRequest :: String -> [Header] -> IO Request+makeRegularPostRequest uri headers = do+ req <- makeGetRequest uri headers+ return $ req { method = BS.pack "POST" }++-- Makes the @makePostRequest@ a PUT request.+makePutRequest :: String -> [Header] -> IO Request+makePutRequest uri headers = do+ req <- makePostRequest uri headers+ return $ req { method = BS.pack "PUT" }++-- Makes a list of multipart parts given a list of parameters+makeMultipartParts :: Parameters -> [Part]+makeMultipartParts ((a,b):cs) = partBS (T.pack a) (BS.pack b) : makeMultipartParts cs+makeMultipartParts _ = []
+ PokitDok/Paths.hs view
@@ -0,0 +1,31 @@+-- | This module contains all of the endpoints+-- available in the PokitDok Platform API.++module PokitDok.Paths where++apiSite = "https://platform.pokitdok.com"+apiVersionPath = "/api/v4"+apiTokenPath = "/oauth2/token"+apiEndpointEligibility = "/eligibility/"+apiEndpointProviders = "/providers/"+apiEndpointClaims = "/claims/"+apiEndpointClaimsStatus = "/claims/status"+apiEndpointEnrollment = "/enrollment/"+apiEndpointDeductible = "/deductible/"+apiEndpointPayers = "/payers/"+apiEndpointPriceInsurance = "/prices/insurance"+apiEndpointPriceCash = "/prices/cash"+apiEndpointActivities = "/activities/"+apiEndpointFiles = "/files/"+apiEndpointTradingPartners = "/tradingpartners/"+apiEndpointPlans = "/plans/"+apiEndpointReferrals = "/referrals/"+apiEndpointAuthorizations = "/authorizations/"+apiEndpointSchedulers = "/schedule/schedulers/";+apiEndpointAppointmentTypes = "/schedule/appointmenttypes/";+apiEndpointSlots = "/schedule/slots/";+apiEndpointAppointments = "/schedule/appointments/";+apiEndpointMPC = "/mpc/"++path :: String+path = apiSite ++ apiVersionPath
+ PokitDok/Requests.hs view
@@ -0,0 +1,163 @@+-- | This module bridges the minimal calls in the+-- Client module, adds specific headers required by+-- the API, and passes them to the more generic calls+-- of the OAuth2 module.+--+-- It also includes auxiliary funtions for handling+-- its main return type: ResponseData.++module PokitDok.Requests+ ( pokitdokGetRequest+ , pokitdokDeleteRequest+ , pokitdokPostRequest+ , pokitdokPutRequest+ , pokitdokMultipartRequest+ , activateKeyWithAuthCode+ , refreshExpired+ , isExpired'+ , assertValid+ , getJSONIO+ ) where++import qualified Codec.Binary.Base64.String as B64+import qualified System.IO.Strict as SIO+import System.Directory (getCurrentDirectory)+import System.Info (os)+import Data.Time.Clock+import Data.Time.Clock.POSIX (getPOSIXTime)+import Data.Time.Calendar (fromGregorian)+import Data.Maybe (fromJust)+import Data.Hex (hex)+import Network.HTTP.Base (httpPackageVersion)++import PokitDok.OAuth2++-- Middle man network calls that provide headers to OAuth2.hs calls.++-- | Sends a get request to the server with the given query parameters.+pokitdokGetRequest+ :: OAuth2 -- ^ An OAuth2 credential.+ -> String -- ^ The request url path.+ -> Parameters -- ^ The query parameters.+ -> IO ResponseData -- ^ The response from the server.+pokitdokGetRequest key = getRequest headers+ where headers = [bearerH . fromJust $ oauthAccessToken key, userAgentH]++-- | Sends a get request to the server with the given query parameters.+pokitdokDeleteRequest+ :: OAuth2 -- ^ A credential.+ -> String -- ^ The request url path.+ -> IO ResponseData -- ^ Response from the server.+pokitdokDeleteRequest key = deleteRequest headers+ where headers = [bearerH . fromJust $ oauthAccessToken key, userAgentH]++-- | Sends a post request to the server and posts the json string.+pokitdokPostRequest+ :: OAuth2 -- ^ Credentials.+ -> String -- ^ The request url path.+ -> String -- ^ JSON object String.+ -> IO ResponseData -- ^ Response from the server.+pokitdokPostRequest key = postRequest headers+ where headers = [bearerH . fromJust $ oauthAccessToken key, userAgentH]++-- | Sends a put request with JSON data.+pokitdokPutRequest+ :: OAuth2 -- ^ Credentials.+ -> String -- ^ The request url path.+ -> String -- ^ A JSON object String.+ -> IO ResponseData -- ^ Response from the server.+pokitdokPutRequest key = putRequest headers+ where headers = [bearerH . fromJust $ oauthAccessToken key, userAgentH]++-- | Makes a multipart request that uploads a file with the given:+pokitdokMultipartRequest+ :: OAuth2 -- ^ Credentials.+ -> String -- ^ The request url path.+ -> Parameters -- ^ Post data.+ -> String -- ^ File system path of file to be posted.+ -> IO ResponseData -- ^ Response from the server.+pokitdokMultipartRequest auth url params pPath = do+ postPath <- format pPath+ boundary <- multipartBoundary+ multipartRequest headers url params postPath boundary+ where+ headers = [bearerH . fromJust $ oauthAccessToken auth, userAgentH]+ osChar =+ if os == "mingw"+ then '\\'+ else '/'+ format file@('C':_) = return file+ format file@('/':_) = return file+ format file = getCurrentDirectory >>= return . (++ [osChar] ++ file)++-- Functions auxiliary to those defined above.++-- The boundary of the PD multipart file upload.+multipartBoundary :: IO String+multipartBoundary = do+ now <- getCurrentTime+ let day0 = UTCTime { utctDay = fromGregorian 0001 01 01+ , utctDayTime = 0+ }+ ticks = floor $ (realToFrac $ diffUTCTime now day0) * 10000000+ return $ "----------------------------" ++ (hex $ show ticks)++-- The bearer authorization header as a String tuple, given an AccessToken.+bearerH :: AccessToken -> (String, String)+bearerH (AccessToken token _ _ _ _) = makeAuthHeader $ "Bearer " ++ token++-- The basic authorization header as a String tuple, given an OAuth2.+basicH :: OAuth2 -> (String, String)+basicH (OAuth2 id sec _ _ _ _) = makeAuthHeader $ "Basic "++B64.encode(id++":"++sec)++-- The pokitdok-haskell user agent header, as a String tuple.+userAgentH :: (String, String)+userAgentH = makeUserAgentHeader $ "haskell-pokitdok/" ++ httpPackageVersion++-- | Pulls the JSON response @String@ from a @ResponseData@ datum,+-- and lifts the result to an IO monad.+getJSONIO :: ResponseData -> IO String+getJSONIO = return . getJSON++-- Extracts the JSON r+getJSON :: ResponseData -> String+getJSON (ResponseData _ body _) = body+++-- Supplementary functions that don't need to be exported by Client.hs,+-- or that need PD network headers.++-- | Takes an @'Oauth2'@ & an authorization code,+-- and returns an @OAuth2@ with a refreshed @AccessToken@.+activateKeyWithAuthCode :: OAuth2 -> String -> IO OAuth2+activateKeyWithAuthCode auth code = do+ token <- authenticateAuthorizationCode headers auth code+ return $ keyModAccessToken auth (Just token)+ where headers = [basicH auth, userAgentH]++-- | Refreshes an @OAuth2@'s token given whether or not it is expired.+refreshExpired :: OAuth2 -> Bool -> IO OAuth2+refreshExpired auth False = return auth+refreshExpired auth@(OAuth2 _ _ _ _ _ (Just (AccessToken _ (Just _) _ _ _))) _ = do+ token <- authenticateRefreshToken headers auth+ return $ keyModAccessToken auth (Just token)+ where headers = [basicH auth, userAgentH]+refreshExpired auth _ = do+ token <- authenticateClientCredentials headers auth+ return $ keyModAccessToken auth (Just token)+ where headers = [basicH auth, userAgentH]++-- | Checks if the given @AccessToken@ is expired.+isExpired' :: AccessToken -> IO Bool+isExpired' (AccessToken _ _ (Just exp) _ _) = getPOSIXTime >>=+ (\now -> return $ (realToFrac now :: Float) > (fromIntegral exp :: Float) - 5) -- 5 sec timeout+isExpired' _ = return False++-- | Asserts that the given @OAuth2@ is valid to make a call.+assertValid :: OAuth2 -> IO ()+assertValid (OAuth2 _ _ _ _ _ Nothing) = error "Access token has not been initialized."+assertValid (OAuth2 _ _ _ _ _ (Just t)) = do+ dead <- isExpired' t+ if dead+ then error "Access token is expired."+ else return ()
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pokitdok.cabal view
@@ -0,0 +1,56 @@+-- Initial pokitdok.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name: pokitdok++-- 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: 4.1.0.0++-- A short (one-line) description of the package.+synopsis: PokitDok Platform API Client for Haskell++-- A longer description of the package.+description: PokitDok's platform gives you access to X12 and Data APIs for health insurance claims, eligibility, providers, procedure pricing and more. This API client allows for seemless integration of API calls in an Haskell module.++-- URL for the project homepage or repository.+homepage: https://platform.pokitdok.com++-- The license under which the package is released.+license: MIT++-- The file containing the license text.+license-file: LICENSE.txt++-- The package author(s).+author: Gage Swenson++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer: gage.swenson@pokitdok.com++-- A copyright notice.+copyright: Copyright © 2014 PokitDok Inc.++category: API++build-type: Simple++-- Constraint on the version of Cabal needed to build this package.+cabal-version: >=1.8+++library+ -- Modules exported by the library.+ exposed-modules: PokitDok, PokitDok.Client, PokitDok.OAuth2, PokitDok.Paths, PokitDok.Requests+ + -- Modules included in this library but not exported.+ -- other-modules: + + -- Other library packages from which modules are imported.+ build-depends: base ==4.6.*, text ==1.2.*, bytestring ==0.10.*, base64-string ==0.2.*, case-insensitive ==1.2.*, time ==1.4.*, http-conduit ==2.1.*, http-client ==0.4.*, http-types ==0.8.*, HTTP ==4000.2.*, aeson ==0.8.*, strict ==0.3.*, directory ==1.2.*, hex ==0.1.*