1 {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
    2 module Static.Fillin
    3   ( staticSendInvestigator
    4   ) where
    5 
    6 import Control.Concurrent (forkIO)
    7 import Control.Exception (handle)
    8 import Control.Monad (void)
    9 import Data.ByteArray.Encoding (convertToBase, Base(Base16))
   10 import qualified Data.ByteString.Char8 as BSC
   11 import qualified Data.Text.Encoding as TE
   12 import Data.Time.Format (formatTime, defaultTimeLocale)
   13 import qualified Network.HTTP.Client as HC
   14 import Network.HTTP.Types.URI (renderSimpleQuery)
   15 
   16 import Service.Types
   17 import Service.Log
   18 import Context
   19 import Model.Party
   20 import Static.Service
   21 
   22 staticSendInvestigator :: Party -> ActionContext -> IO ()
   23 staticSendInvestigator p ActionContext{ contextTimestamp = t, contextService = rc@Service{ serviceStatic = Static{ staticAuthorizeAddr = a, staticInvestigator = Just req, staticKey = key } } } = void $ forkIO $
   24   handle
   25     (\(e :: HC.HttpException) -> logMsg t ("staticSendInvestigator: " ++ show e) (serviceLogs rc))
   26     $ void $ HC.httpNoBody req
   27       { HC.requestBody = HC.RequestBodyBS $ renderSimpleQuery False fields
   28       } (serviceHTTPClient rc)
   29   where
   30   fields =
   31     [ ("auth", convertToBase Base16 $ key $ foldMap snd $ tail fields)
   32     , ("id", BSC.pack $ show $ partyId $ partyRow p)
   33     , ("name", TE.encodeUtf8 $ partyName $ partyRow p)
   34     , ("date", BSC.pack $ formatTime defaultTimeLocale "%B %e, %Y" t)
   35     , ("mail", a)
   36     ]
   37 staticSendInvestigator _ _ = return ()