Skip to content
Snippets Groups Projects
Select Git revision
  • 1125fc0900488e9e8f5d208fd489e3e6d672b91d
  • master default protected
2 results

run-document-server.sh

Blame
  • API.hs 9.89 KiB
    -- |
    -- Module      :  Pelican.API
    -- Copyright   :  Jan Hamal Dvořák
    -- License     :  AGPL-3.0-or-later
    --
    -- Maintainer  :  jan.hamal.dvorak@pirati.cz
    -- Stability   :  unstable
    -- Portability :  non-portable (ghc)
    --
    
    module Pelican.API
      ( apiRoutes
      )
    where
      import Praha
    
      import Pelican.Action
      import Pelican.Common
      import Pelican.Model
      import Pelican.Types
    
      import Data.Aeson as Aeson
      import Data.Text (splitOn)
      import Data.UUID (UUID, fromText, toText)
    
      import Data.Time.Clock
      import Data.Time.Calendar.OrdinalDate
      import Data.Time.Format.ISO8601
    
    
      apiRoutes :: Dispatch (Action ()) ()
      apiRoutes = do
        route getReceiptR
        route getReceiptsR
        route postSendToNumberR
        route postSendToContactR
    
    
      newtype ParamUUID = ParamUUID UUID
    
      instance Param ParamUUID where
        fromParam = fmap ParamUUID . fromText
        toParam (ParamUUID uuid) = toText uuid
    
    
      pgConflict :: SqlError -> Action ()
      pgConflict SqlError{..} = do
        abort conflict409 [] (cs sqlErrorDetail)
    
    
      postSendToNumberR :: Route '[] (Action ())
      postSendToNumberR = post handle // "v1" // "send" // "to-number"
                                      /? acceptJSON /? offerText
        where
          handle = do
            -- Read the request. Automatically dies on parsing error.
            SendToNumber{..} <- getJSON
    
            -- Check that the application is allowed to be billed.
            checkBilling BillSender application token
    
            -- Check that the application has not yet exceeded its daily quota.
            checkQuota application
    
            case centre of
              Nothing -> return ()
              Just cc -> checkCostCentre cc
    
            handlePgErrors pgConflict ["23505"] do
              -- Proceed to insert the message into the history and queue.