import           Control.Monad.Trans.Except     ( withExceptT
                                                )
import           Control.Monad.Trans.Reader     ( mapReaderT
                                                )

import           Control.Monad.Trans.Except     ( withExceptT )
import           Control.Monad.Trans.Reader     ( mapReaderT )

import           Haskoin.Address        ( Address )

import           Haskoin.Address                ( Address )

import           Bippy.Types            ( Satoshi )

import           Bippy.Types                    ( Satoshi )

import           Bippy.Types            ( Satoshi(..) )

import           Bippy.Types                    ( Satoshi(..) )

{-
 - A stream of dates upon which the specified subscription
 - should be billed, beginning with the first day of the
 - subscription.
 -}

-- | A stream of dates upon which the specified subscription
-- should be billed, beginning with the first day of the
-- subscription.

  let rec = view (billable . recurrence) s
      subEndDay = preview (endTime . _Just . C._utctDay) s

  unfoldr next (Just $ view (startTime . C._utctDay) s)
  where
    rec = view (billable . recurrence) s
    subEndDay = preview (endTime . _Just . C._utctDay) s

      next :: Maybe T.Day -> Maybe (T.Day, Maybe T.Day)
      next d = do
        d' <- d
        if (all (d' <) subEndDay) then Just (d', nextRecurrence rec d') else Nothing

    next :: Maybe T.Day -> Maybe (T.Day, Maybe T.Day)
    next d = do
      d' <- d
      if (all (d' <) subEndDay) then Just (d', nextRecurrence rec d') else Nothing

  in  unfoldr next (Just $ view (startTime . C._utctDay) s)

import qualified Bippy.Types           as BT

import qualified Bippy.Types                   as BT

import           Bippy.Types            ( Satoshi(..) )

import           Bippy.Types                    ( Satoshi(..) )

import           Bippy.Types            ( Satoshi(..) )
import           Haskoin.Address        ( Address

import           Bippy.Types                    ( Satoshi(..) )
import           Haskoin.Address                ( Address

import           Haskoin.Constants      ( Network )

import           Haskoin.Constants              ( Network )

  let err = returnError ConversionFailed
                        f
                        ("could not deserialize value " <> T.unpack fieldValue <>
                         " to a valid BTC address for network " <> show n
                        )

  let err = returnError
        ConversionFailed
        f
        (  "could not deserialize value "
        <> T.unpack fieldValue
        <> " to a valid BTC address for network "
        <> show n
        )

  where
    parser :: Text -> RowParser (CreditTo (NetworkId, Address))
    parser = \case
      "credit_to_address" -> CreditToCurrency <$> (addressParser mode     <* nullField       <* nullField)
      "credit_to_user"    -> CreditToUser     <$> (nullField *> nullField *> idParser UserId <* nullField)
      "credit_to_project" -> CreditToProject  <$> (nullField *> nullField *> nullField       *> idParser ProjectId)
      _ -> empty

 where
  parser :: Text -> RowParser (CreditTo (NetworkId, Address))
  parser = \case
    "credit_to_address" ->
      CreditToCurrency <$> (addressParser mode <* nullField <* nullField)
    "credit_to_user" ->
      CreditToUser <$> (nullField *> nullField *> idParser UserId <* nullField)
    "credit_to_project" ->
      CreditToProject
        <$> (nullField *> nullField *> nullField *> idParser ProjectId)
    _ -> empty

import           Haskoin.Address        ( Address )

import           Haskoin.Address                ( Address )

  CreateUser       ::BTCUser -> DBOp UserId
  FindUser         ::UserId -> DBOp (Maybe BTCUser)
  FindUserByName   ::UserName -> DBOp (Maybe (UserId, BTCUser))

  CreateUser       :: BTCUser -> DBOp UserId
  FindUser         :: UserId -> DBOp (Maybe BTCUser)
  FindUserByName   :: UserName -> DBOp (Maybe (UserId, BTCUser))

  CreateProject    ::Project -> DBOp ProjectId
  FindProject      ::ProjectId -> DBOp (Maybe Project)
  ListProjects     ::DBOp [ProjectId]
  FindSubscribers  ::ProjectId -> DBOp [UserId]
  FindUserProjects ::UserId -> DBOp [(ProjectId, Project)]
  AddUserToProject ::ProjectId -> InvitingUID -> InvitedUID -> DBOp ()
  CreateInvitation ::ProjectId -> InvitingUID -> Email -> C.UTCTime -> DBOp InvitationCode
  FindInvitation   ::InvitationCode -> DBOp (Maybe Invitation)
  AcceptInvitation ::UserId -> InvitationCode -> C.UTCTime -> DBOp ()

  CreateProject    :: Project -> DBOp ProjectId
  FindProject      :: ProjectId -> DBOp (Maybe Project)
  ListProjects     :: DBOp [ProjectId]
  FindSubscribers  :: ProjectId -> DBOp [UserId]
  FindUserProjects :: UserId -> DBOp [(ProjectId, Project)]
  AddUserToProject :: ProjectId -> InvitingUID -> InvitedUID -> DBOp ()
  CreateInvitation :: ProjectId -> InvitingUID -> Email -> C.UTCTime -> DBOp InvitationCode
  FindInvitation   :: InvitationCode -> DBOp (Maybe Invitation)
  AcceptInvitation :: UserId -> InvitationCode -> C.UTCTime -> DBOp ()

  CreateEvent      ::ProjectId -> UserId -> LogEntry BTCNet -> DBOp EventId
  AmendEvent       ::EventId -> EventAmendment BTCNet -> DBOp AmendmentId
  FindEvent        ::EventId -> DBOp (Maybe (KeyedLogEntry BTCNet))
  FindEvents       ::ProjectId -> UserId -> RangeQuery -> Word32 -> DBOp [LogEntry BTCNet]
  ReadWorkIndex    ::ProjectId -> DBOp (WorkIndex BTCNet)

  CreateEvent      :: ProjectId -> UserId -> LogEntry BTCNet -> DBOp EventId
  AmendEvent       :: EventId -> EventAmendment BTCNet -> DBOp AmendmentId
  FindEvent        :: EventId -> DBOp (Maybe (KeyedLogEntry BTCNet))
  FindEvents       :: ProjectId -> UserId -> RangeQuery -> Word32 -> DBOp [LogEntry BTCNet]
  ReadWorkIndex    :: ProjectId -> DBOp (WorkIndex BTCNet)

  CreateAuction    ::Auction -> DBOp AuctionId
  FindAuction      ::AuctionId -> DBOp (Maybe Auction)
  CreateBid        ::AuctionId -> Bid -> DBOp BidId
  FindBids         ::AuctionId -> DBOp [(BidId, Bid)]

  CreateAuction    :: Auction -> DBOp AuctionId
  FindAuction      :: AuctionId -> DBOp (Maybe Auction)
  CreateBid        :: AuctionId -> Bid -> DBOp BidId
  FindBids         :: AuctionId -> DBOp [(BidId, Bid)]

  CreateBillable   ::UserId -> Billable -> DBOp BillableId
  FindBillable     ::BillableId -> DBOp (Maybe Billable)
  FindBillables    ::ProjectId  -> DBOp [(BillableId, Billable)]

  CreateBillable   :: UserId -> Billable -> DBOp BillableId
  FindBillable     :: BillableId -> DBOp (Maybe Billable)
  FindBillables    :: ProjectId  -> DBOp [(BillableId, Billable)]

  CreateSubscription ::UserId -> BillableId -> T.Day -> DBOp SubscriptionId
  FindSubscription   ::SubscriptionId -> DBOp (Maybe Subscription)
  FindSubscriptions  ::UserId -> ProjectId -> DBOp [(SubscriptionId, Subscription)]

  CreateSubscription :: UserId -> BillableId -> T.Day -> DBOp SubscriptionId
  FindSubscription   :: SubscriptionId -> DBOp (Maybe Subscription)
  FindSubscriptions  :: UserId -> ProjectId -> DBOp [(SubscriptionId, Subscription)]

  CreatePaymentRequest  ::PaymentRequest -> DBOp PaymentRequestId
  FindPaymentRequests   ::SubscriptionId -> DBOp [(PaymentRequestId, PaymentRequest)]
  FindUnpaidRequests    ::SubscriptionId -> DBOp [BillDetail]
  FindPaymentRequest    ::PaymentKey -> DBOp (Maybe (PaymentRequestId, PaymentRequest))
  FindPaymentRequestId  ::PaymentRequestId -> DBOp (Maybe PaymentRequest)

  CreatePaymentRequest  :: PaymentRequest -> DBOp PaymentRequestId
  FindPaymentRequests   :: SubscriptionId -> DBOp [(PaymentRequestId, PaymentRequest)]
  FindUnpaidRequests    :: SubscriptionId -> DBOp [BillDetail]
  FindPaymentRequest    :: PaymentKey -> DBOp (Maybe (PaymentRequestId, PaymentRequest))
  FindPaymentRequestId  :: PaymentRequestId -> DBOp (Maybe PaymentRequest)

  CreatePayment  ::Payment -> DBOp PaymentId
  FindPayments   ::PaymentRequestId -> DBOp [(PaymentId, Payment)]

  CreatePayment  :: Payment -> DBOp PaymentId
  FindPayments   :: PaymentRequestId -> DBOp [(PaymentId, Payment)]

  RaiseDBError     :: forall x y. DBError -> DBOp x -> DBOp y

  RaiseDBError   :: forall x y. DBError -> DBOp x -> DBOp y

  :: (MonadDB m) => ProjectId -> UserId -> RangeQuery -> Word32 -> m [LogEntry BTCNet]

  :: (MonadDB m)
  => ProjectId
  -> UserId
  -> RangeQuery
  -> Word32
  -> m [LogEntry BTCNet]

import           Haskoin.Address        ( Address

import           Haskoin.Address                ( Address

  v1 $ obj
    [(name <> "Id") .= idValue _id x
    , name .= (x ^. _value)
    ]

  v1 $ obj [(name <> "Id") .= idValue _id x, name .= (x ^. _value)]

workIndexJSON nmode (WorkIndex widx) =
  v2 $ obj ["workIndex" .= fmap widxRec (MS.assocs widx)]
  where
    widxRec :: (CreditTo (NetworkId, Address), NonEmpty Interval) -> Value
    widxRec (c, l) = object
      [ "creditTo" .= creditToJSON nmode c
      , "intervals" .= (intervalJSON <$> L.toList l)
      ]

workIndexJSON nmode (WorkIndex widx) = v2
  $ obj ["workIndex" .= fmap widxRec (MS.assocs widx)]
 where
  widxRec :: (CreditTo (NetworkId, Address), NonEmpty Interval) -> Value
  widxRec (c, l) = object
    [ "creditTo" .= creditToJSON nmode c
    , "intervals" .= (intervalJSON <$> L.toList l)
    ]

qdbBillableJSON = qdbJSON "billable" (_1 . B._BillableId) (_2 . to billableJSON)

qdbBillableJSON =
  qdbJSON "billable" (_1 . B._BillableId) (_2 . to billableJSON)

import qualified Bippy.Proto           as P
import           Bippy.Types            ( expiryTime

import qualified Bippy.Proto                   as P
import           Bippy.Types                    ( expiryTime

import           Haskoin.Address.Base58 ( decodeBase58Check )

import           Haskoin.Address.Base58         ( decodeBase58Check )

  ) where

  )
where

import           Control.Error.Util      (maybeT)
import           Control.Lens            (makeClassy, makeClassyPrisms, review,
                                          view, (%~), (^.), traverseOf)

import           Control.Error.Util             ( maybeT )
import           Control.Lens                   ( makeClassy
                                                , makeClassyPrisms
                                                , review
                                                , view
                                                , (%~)
                                                , (^.)
                                                , traverseOf
                                                )

import           Control.Monad.Except    (MonadError, throwError)
import qualified Crypto.PubKey.RSA.Types as RSA (Error (..), PrivateKey)
import           Crypto.Random.Types     (MonadRandom, getRandomBytes)

import           Control.Monad.Except           ( MonadError
                                                , throwError
                                                )
import qualified Crypto.PubKey.RSA.Types       as RSA
                                                ( Error(..)
                                                , PrivateKey
                                                )
import           Crypto.Random.Types            ( MonadRandom
                                                , getRandomBytes
                                                )

import           Data.AffineSpace        ((.+^))
import           Data.Map.Strict         (assocs)
import           Data.Thyme.Clock        as C
import           Data.Thyme.Time         as T

import           Data.AffineSpace               ( (.+^) )
import           Data.Map.Strict                ( assocs )
import           Data.Thyme.Clock              as C
import           Data.Thyme.Time               as T

import qualified Bippy           as B
import qualified Bippy.Proto     as P
import qualified Bippy.Types     as BT
import           Haskoin.Address (Address(..))
import           Haskoin.Address.Base58 (encodeBase58Check)
import           Haskoin.Script  (ScriptOutput (..))

import qualified Bippy                         as B
import qualified Bippy.Proto                   as P
import qualified Bippy.Types                   as BT
import           Haskoin.Address                ( Address(..) )
import           Haskoin.Address.Base58         ( encodeBase58Check )
import           Haskoin.Script                 ( ScriptOutput(..) )

import           Aftok.Types             (UserId, ProjectId, userAddress)

import           Aftok.Types                    ( UserId
                                                , ProjectId
                                                , userAddress
                                                )

import           Aftok.Currency.Bitcoin  (NetworkId(..), NetworkMode, satoshi, toNetwork)

import           Aftok.Currency.Bitcoin         ( NetworkId(..)
                                                , NetworkMode
                                                , satoshi
                                                , toNetwork
                                                )

import           Aftok.Project           (depf)
import qualified Aftok.TimeLog           as TL

import           Aftok.Project                  ( depf )
import qualified Aftok.TimeLog                 as TL

createPaymentRequests :: ( MonadRandom m
                         , MonadReader r m, HasPaymentsConfig r
                         , MonadError e m,  AsPaymentError e
                         , MonadDB m
                         )
                      => BillingOps m -- ^ generators for payment request components
                      -> C.UTCTime    -- ^ timestamp for payment request creation
                      -> UserId       -- ^ customer responsible for payment
                      -> ProjectId    -- ^ project whose worklog is to be paid
                      -> m [PaymentRequestId]

createPaymentRequests
  :: ( MonadRandom m
     , MonadReader r m
     , HasPaymentsConfig r
     , MonadError e m
     , AsPaymentError e
     , MonadDB m
     )
  => BillingOps m -- ^ generators for payment request components
  -> C.UTCTime    -- ^ timestamp for payment request creation
  -> UserId       -- ^ customer responsible for payment
  -> ProjectId    -- ^ project whose worklog is to be paid
  -> m [PaymentRequestId]

createSubscriptionPaymentRequests ::
     ( MonadRandom m
     , MonadReader r m, HasPaymentsConfig r
     , MonadError e m, AsPaymentError e

createSubscriptionPaymentRequests
  :: ( MonadRandom m
     , MonadReader r m
     , HasPaymentsConfig r
     , MonadError e m
     , AsPaymentError e

  billableSub <- maybeT (raiseSubjectNotFound . FindBillable $ sub ^. billable) pure $
                 traverseOf billable findBillable sub

  billableSub <-
    maybeT (raiseSubjectNotFound . FindBillable $ sub ^. billable) pure
      $ traverseOf billable findBillable sub

  billableDates   <- findUnbilledDates now (view billable billableSub) paymentRequests $
                     takeWhile (< view _utctDay now) $ billingSchedule billableSub

  billableDates   <-
    findUnbilledDates now (view billable billableSub) paymentRequests
    $ takeWhile (< view _utctDay now)
    $ billingSchedule billableSub

createPaymentRequest ::
     ( MonadRandom m
     , MonadReader r m, HasPaymentsConfig r
     , MonadError e m, AsPaymentError e

createPaymentRequest
  :: ( MonadRandom m
     , MonadReader r m
     , HasPaymentsConfig r
     , MonadError e m
     , AsPaymentError e

  cfg <- ask

  cfg     <- ask

findUnbilledDates :: (MonadDB m, MonadError e m, AsPaymentError e)
                  => C.UTCTime -- ^ the date against which payment request expiration should be checked
                  -> Billable
                  -> [(PaymentRequestId, PaymentRequest)] -- ^ the list of existing payment requests
                  -> [T.Day]   -- ^ the list of expected billing days
                  -> m [T.Day] -- ^ the list of billing days for which no payment request exists
findUnbilledDates now b (px @ (p : ps)) (dx @ (d : ds)) =

findUnbilledDates
  :: (MonadDB m, MonadError e m, AsPaymentError e)
  => C.UTCTime -- ^ the date against which payment request expiration should be checked
  -> Billable
  -> [(PaymentRequestId, PaymentRequest)] -- ^ the list of existing payment requests
  -> [T.Day]   -- ^ the list of expected billing days
  -> m [T.Day] -- ^ the list of billing days for which no payment request exists
findUnbilledDates now b (px@(p : ps)) (dx@(d : ds)) =

            Expired r -> if view _utctDay now > addDays (view gracePeriod b) (view billingDate r)
                           then throwError (review _Overdue (r ^. subscription))
                           else fmap (d :) $ findUnbilledDates now b px dx -- d will be rebilled
            _         -> findUnbilledDates now b ps ds -- if paid or unpaid, nothing to do

      Expired r ->
        if view _utctDay now > addDays (view gracePeriod b) (view billingDate r)
          then throwError (review _Overdue (r ^. subscription))
          else fmap (d :) $ findUnbilledDates now b px dx -- d will be rebilled
      _ -> findUnbilledDates now b ps ds -- if paid or unpaid, nothing to do

getRequestStatus :: (MonadDB m)
                 => C.UTCTime -- ^ the date against which request expiration should be checked
                 -> (PaymentRequestId, PaymentRequest) -- ^ the request for which to find a payment
                 -> m PaymentRequestStatus

getRequestStatus
  :: (MonadDB m)
  => C.UTCTime -- ^ the date against which request expiration should be checked
  -> (PaymentRequestId, PaymentRequest) -- ^ the request for which to find a payment
  -> m PaymentRequestStatus

     , MonadReader r m , HasPaymentsConfig r
     , MonadError e m, AsPaymentError e

     , MonadReader r m
     , HasPaymentsConfig r
     , MonadError e m
     , AsPaymentError e

  let expiry = (BT.Expiry . T.fromThyme . (billingTime .+^)) <$> (b ^. requestExpiryPeriod)

  let expiry =
        (BT.Expiry . T.fromThyme . (billingTime .+^))
          <$> (b ^. requestExpiryPeriod)

  pure $ B.createPaymentDetails
    (toNetwork (cfg ^. networkMode) BTC)
    outputs
    (T.fromThyme billingTime)
    expiry memo uri payload
  where
    payoutTime = T.mkUTCTime payoutDate (fromInteger 0)

  pure $ B.createPaymentDetails (toNetwork (cfg ^. networkMode) BTC)
                                outputs
                                (T.fromThyme billingTime)
                                expiry
                                memo
                                uri
                                payload
  where payoutTime = T.mkUTCTime payoutDate (fromInteger 0)

    other -> throwError $ review _IllegalAddress other

    other           -> throwError $ review _IllegalAddress other

findPayableRequests :: (MonadDB m) => UserId -> SubscriptionId -> C.UTCTime -> m [BillDetail]

findPayableRequests
  :: (MonadDB m) => UserId -> SubscriptionId -> C.UTCTime -> m [BillDetail]

  join <$> (traverse checkAccess $ filter (not . isExpired now . view _2) requests)
  where
    findOp = FindUnpaidRequests sid
    checkAccess d =
      if view (_3 . customer) d == uid
        then pure [d]
        else raiseOpForbidden uid (UserNotSubscriber sid) findOp

  join
    <$> (traverse checkAccess $ filter (not . isExpired now . view _2) requests)
 where
  findOp = FindUnpaidRequests sid
  checkAccess d = if view (_3 . customer) d == uid
    then pure [d]
    else raiseOpForbidden uid (UserNotSubscriber sid) findOp

  ( LogEntry(..), creditTo, event, eventMeta
  , CreditTo(..), _CreditToCurrency, _CreditToUser, _CreditToProject, creditToName
  , LogEvent(..), eventName, nameEvent, eventTime
  , WorkIndex(WorkIndex), _WorkIndex, workIndex
  , DepF, toDepF
  , EventId(EventId), _EventId
  , ModTime(ModTime), _ModTime

  ( LogEntry(..)
  , creditTo
  , event
  , eventMeta
  , CreditTo(..)
  , _CreditToCurrency
  , _CreditToUser
  , _CreditToProject
  , creditToName
  , LogEvent(..)
  , eventName
  , nameEvent
  , eventTime
  , WorkIndex(WorkIndex)
  , _WorkIndex
  , workIndex
  , DepF
  , toDepF
  , EventId(EventId)
  , _EventId
  , ModTime(ModTime)
  , _ModTime

  , AmendmentId(AmendmentId), _AmendmentId
  , Payouts(..), _Payouts

  , AmendmentId(AmendmentId)
  , _AmendmentId
  , Payouts(..)
  , _Payouts

  ) where

  )
where

import           Control.Arrow      ((&&&))

import           Control.Arrow                  ( (&&&) )

import           Data.Aeson         as A

import           Data.Aeson                    as A

import           Data.Eq            (Eq, (==))
import           Data.Either        (Either(..), rights)
import           Data.Foldable      as F
import           Data.Function      (($), (.), id)
import           Data.Functor       (fmap)
import           Data.Heap          as H
import           Data.List.NonEmpty as L
import           Data.Maybe         (Maybe(..))
import           Data.Map.Strict    as MS
import           Data.Ord           (Ord(..), Ordering(..))
import           Data.Ratio         (Rational)
import           Data.Text          (Text)
import           Data.Thyme.Clock   as C

import           Data.Eq                        ( Eq
                                                , (==)
                                                )
import           Data.Either                    ( Either(..)
                                                , rights
                                                )
import           Data.Foldable                 as F
import           Data.Function                  ( ($)
                                                , (.)
                                                , id
                                                )
import           Data.Functor                   ( fmap )
import           Data.Heap                     as H
import           Data.List.NonEmpty            as L
import           Data.Maybe                     ( Maybe(..) )
import           Data.Map.Strict               as MS
import           Data.Ord                       ( Ord(..)
                                                , Ordering(..)
                                                )
import           Data.Ratio                     ( Rational )
import           Data.Text                      ( Text )
import           Data.Thyme.Clock              as C

import           Prelude            ((/), (*))
import           Text.Show          (Show)

import           Prelude                        ( (/)
                                                , (*)
                                                )
import           Text.Show                      ( Show )

toDepF (LinearDepreciation undepLength depLength)  = linearDepreciation undepLength depLength

toDepF (LinearDepreciation undepLength depLength) =
  linearDepreciation undepLength depLength

      addIntervalDiff total ivals = (^+^ total) &&& id $ workCredit dep ptime ivals

      addIntervalDiff total ivals =
          (^+^ total) &&& id $ workCredit dep ptime ivals

workIndex :: (Ord a, Foldable f) => f (LogEntry a) -> (WorkIndex a)

workIndex
  :: forall a f . (Ord a, Foldable f) => f (LogEntry a) -> (WorkIndex a)

      rawIndex = F.foldl' appendLogEntry MS.empty sortedEntries

      rawIndex      = F.foldl' appendLogEntry MS.empty sortedEntries

      accum
        :: (CreditTo a)
        -> [Either LogEvent Interval]
        -> Map (CreditTo a) (NonEmpty Interval)
        -> Map (CreditTo a) (NonEmpty Interval)

  let combine (StartWork t) (StopWork t') | t' > t = Right $ Interval t t'
      combine (e1 @ (StartWork _)) (e2 @ (StartWork _)) = Left $ max e1 e2 -- ignore redundant starts
      combine (e1 @ (StopWork  _)) (e2 @ (StopWork  _)) = Left $ min e1 e2 -- ignore redundant ends
      combine _ e2 = Left e2

  let combine :: LogEvent -> LogEvent -> Either LogEvent Interval
      combine (StartWork t) (StopWork t') | t' > t  = Right $ Interval t t'
      combine (e1@(StartWork _)) (e2@(StartWork _)) = Left $ max e1 e2 -- ignore redundant starts
      combine (e1@(StopWork  _)) (e2@(StopWork  _)) = Left $ min e1 e2 -- ignore redundant ends
      combine _                  e2                 = Left e2

      extension ival (StartWork t) | containsInclusive t ival = Just $ StartWork (ival ^. start)

      extension ival (StartWork t) | containsInclusive t ival =
          Just $ StartWork (ival ^. start)

        _ -> [Left ev]

        _                    -> [Left ev]

linearDepreciation :: Months -- ^ The number of initial months during which no depreciation occurs
                   -> Months -- ^ The number of months over which each logged interval will be depreciated
                   -> DepF   -- ^ The resulting configured depreciation function.

linearDepreciation
  :: Months -- ^ The number of initial months during which no depreciation occurs
  -> Months -- ^ The number of months over which each logged interval will be depreciated
  -> DepF   -- ^ The resulting configured depreciation function.

      depPct dt =
        if dt < monthsLength undepLength then 1
        else toSeconds (max zeroV (maxDepreciable ^-^ dt)) / toSeconds maxDepreciable

      depPct dt = if dt < monthsLength undepLength
        then 1
        else toSeconds (max zeroV (maxDepreciable ^-^ dt))
          / toSeconds maxDepreciable

    let depreciation = depPct $ ptime .-. (ival ^. end)
    in  depreciation *^ ilen ival

        let depreciation = depPct $ ptime .-. (ival ^. end)
        in  depreciation *^ ilen ival

import           Bippy.Types            ( Satoshi(..) )

import           Bippy.Types                    ( Satoshi(..) )

import           Data.Aeson                     ((.:))
import qualified Data.Aeson                     as A
import qualified Data.Aeson.Types               as A

import           Data.Aeson                     ( (.:) )
import qualified Data.Aeson                    as A
import qualified Data.Aeson.Types              as A

parseLoginRequest (A.Object o) = LoginRequest <$> o .: "username" <*> o .: "password"

parseLoginRequest (A.Object o) =
  LoginRequest <$> o .: "username" <*> o .: "password"

requireLoginWith :: (forall a. () -> S.Handler App App a) -> S.Handler App App AU.AuthUser

requireLoginWith
  :: (forall a . () -> S.Handler App App a) -> S.Handler App App AU.AuthUser

  req          <- getRequest
  rawHeader    <- maybe (throwMissingAuth ()) pure $ getHeader "Authorization" req

  req <- getRequest
  rawHeader <- maybe (throwMissingAuth ()) pure $ getHeader "Authorization" req

  credentials <- case
      A.eitherDecode requestBody >>= A.parseEither parseLoginRequest
    of
      Left _ -> snapError 400 $ "Unable to parse login credentials object."

  credentials <-
    case A.eitherDecode requestBody >>= A.parseEither parseLoginRequest of
      Left  _     -> snapError 400 $ "Unable to parse login credentials object."

  authResult <- with auth $ AU.loginByUsername (loginUser credentials) (AU.ClearText (encodeUtf8 $ loginPass credentials)) False

  authResult <- with auth $ AU.loginByUsername
    (loginUser credentials)
    (AU.ClearText (encodeUtf8 $ loginPass credentials))
    False

  maybe (requireLoginWith $ const (throwDenied $ AU.AuthError "Not Authenticated")) pure currentUser

  maybe
    (requireLoginWith $ const (throwDenied $ AU.AuthError "Not Authenticated"))
    pure
    currentUser

import           Bippy.Types            ( Satoshi(..) )

import           Bippy.Types                    ( Satoshi(..) )

import qualified Bippy.Proto           as P

import qualified Bippy.Proto                   as P

import           Control.Monad.Trans.Maybe      ( mapMaybeT
                                                )

import           Control.Monad.Trans.Maybe      ( mapMaybeT )

import           Haskoin.Address        ( textToAddr )

import           Haskoin.Address                ( textToAddr )

import           Data.Attoparsec.ByteString     (parseOnly)
import           Data.Attoparsec.ByteString.Char8     (decimal)

import           Data.Attoparsec.ByteString     ( parseOnly )
import           Data.Attoparsec.ByteString.Char8
                                                ( decimal )

import           Control.Lens                   ((^.))

import           Control.Lens                   ( (^.) )

import           Data.Aeson                     ((.=))

import           Data.Aeson                     ( (.=) )

import           Haskoin.Address        ( Address

import           Haskoin.Address                ( Address

import           Aftok.Types                    ( _ProjectId, _UserId )

import           Aftok.Types                    ( _ProjectId
                                                , _UserId
                                                )

logWorkHandler :: (C.UTCTime -> LogEvent) -> S.Handler App App (EventId, KeyedLogEntry BTCNet)

logWorkHandler
  :: (C.UTCTime -> LogEvent)
  -> S.Handler App App (EventId, KeyedLogEntry BTCNet)

      A.eitherDecode requestBody >>= A.parseEither (parseLogEntry nmode uid evCtr)

      A.eitherDecode requestBody
        >>= A.parseEither (parseLogEntry nmode uid evCtr)

          (snapError 500 $ "An error occured retrieving the newly created event record.")
          (pure . (eid,))

          ( snapError 500
          $ "An error occured retrieving the newly created event record."
          )
          (pure . (eid, ))

  limit     <- fromMaybe 1 <$> decimalParam "limit"

  limit <- fromMaybe 1 <$> decimalParam "limit"

userWorkIndex =
  workIndex <$> userEvents

userWorkIndex = workIndex <$> userEvents

keyedLogEntryJSON :: NetworkMode -> (EventId, KeyedLogEntry (NetworkId, Address)) -> A.Value
keyedLogEntryJSON nmode (eid, (pid, uid, ev)) = v2 . obj $
  [ "eventId"   .= idValue _EventId eid
  , "projectId" .= idValue _ProjectId pid
  , "loggedBy"  .= idValue _UserId uid
  ] <> logEntryFields nmode ev

keyedLogEntryJSON
  :: NetworkMode -> (EventId, KeyedLogEntry (NetworkId, Address)) -> A.Value
keyedLogEntryJSON nmode (eid, (pid, uid, ev)) =
  v2
    .  obj
    $  [ "eventId" .= idValue _EventId eid
       , "projectId" .= idValue _ProjectId pid
       , "loggedBy" .= idValue _UserId uid
       ]
    <> logEntryFields nmode ev

import qualified Snap.Snaplet.Auth as AU

import qualified Snap.Snaplet.Auth             as AU

  sesss <- nestSnaplet "sessions" sess $ initCookieSessionManager cookieKey "quookie" Nothing (cfg ^. cookieTimeout)

  sesss <- nestSnaplet "sessions" sess
    $ initCookieSessionManager
        cookieKey
        "quookie"
        Nothing
        (cfg ^. cookieTimeout)

    projectRoute =
      serveJSON projectJSON $ method GET projectGetHandler

    projectRoute = serveJSON projectJSON $ method GET projectGetHandler

    amendEventRoute =
      serveJSON amendmentIdJSON $ method PUT amendEventHandler

    amendEventRoute = serveJSON amendmentIdJSON $ method PUT amendEventHandler

    auctionRoute    =
      serveJSON auctionJSON $ method GET auctionGetHandler
    auctionBidRoute =
      serveJSON bidIdJSON $ method POST auctionBidHandler

    auctionRoute    = serveJSON auctionJSON $ method GET auctionGetHandler
    auctionBidRoute = serveJSON bidIdJSON $ method POST auctionBidHandler

    , ("login"                              , loginRoute)
    , ("login"                              , xhrLoginRoute)
    , ("logout"                             , logoutRoute)
    , ("login/check"                        , checkLoginRoute)
    , ("register"                           , registerRoute)
    , ("accept_invitation"                  , acceptInviteRoute)

    , ("login"      , loginRoute)
    , ("login"      , xhrLoginRoute)
    , ("logout"     , logoutRoute)
    , ("login/check", checkLoginRoute)
    , ("register"   , registerRoute)
    , ( "accept_invitation"
      , acceptInviteRoute
      )

    , ("user/projects/:projectId/logStart"     , logWorkRoute StartWork)
    , ("user/projects/:projectId/logEnd"       , logWorkRoute StopWork)
    , ("user/projects/:projectId/events"       , userEventsRoute)
    , ("user/projects/:projectId/workIndex"    , userWorkIndexRoute)
    , ("projects/:projectId/workIndex"         , projectWorkIndexRoute)
    , ("projects/:projectId/auctions"  , auctionCreateRoute) -- <|> auctionListRoute)
    , ("projects/:projectId/billables" , billableCreateRoute <|> billableListRoute)
    , ("projects/:projectId/payouts"   , projectPayoutsRoute)
    , ("projects/:projectId/invite"    , inviteRoute)
    , ("projects/:projectId"           , projectRoute)
    , ("projects"                      , projectCreateRoute <|> projectListRoute)

    , ("user/projects/:projectId/logStart" , logWorkRoute StartWork)
    , ("user/projects/:projectId/logEnd"   , logWorkRoute StopWork)
    , ("user/projects/:projectId/events"   , userEventsRoute)
    , ("user/projects/:projectId/workIndex", userWorkIndexRoute)
    , ("projects/:projectId/workIndex"     , projectWorkIndexRoute)
    , ( "projects/:projectId/auctions"
      , auctionCreateRoute
      ) -- <|> auctionListRoute)
    , ( "projects/:projectId/billables"
      , billableCreateRoute <|> billableListRoute
      )
    , ("projects/:projectId/payouts", projectPayoutsRoute)
    , ("projects/:projectId/invite" , inviteRoute)
    , ("projects/:projectId"        , projectRoute)
    , ("projects"                   , projectCreateRoute <|> projectListRoute)

    haskellPackages.brittany

import           Data.List                      ((!!))

import           Data.List                      ( (!!) )

import qualified Data.UUID.V4                   as U

import qualified Data.UUID.V4                  as U

    it
        "determines a sufficient number of winners to fulfill the raise amount"

    it "determines a sufficient number of winners to fulfill the raise amount"

          result = runAuction' (Satoshi 1250)
                               [testB0, testB1, testB2, testB3, testB4]

          result =
            runAuction' (Satoshi 1250) [testB0, testB1, testB2, testB3, testB4]

            WinningBids winners ->
              sortBy bidOrder winners `shouldBe` expected

            WinningBids winners -> sortBy bidOrder winners `shouldBe` expected

import           Haskoin.Address        ( Address )

import           Haskoin.Address                ( Address )

import           Haskoin.Util.Arbitrary.Address (arbitraryAddress)

import           Haskoin.Util.Arbitrary.Address ( arbitraryAddress )